Đọc tập tin pdf và đưa vào Excel

Liên hệ QC

levanduyet

Hãy để gió cuốn đi.
Thành viên danh dự
Tham gia
30/5/06
Bài viết
1,798
Được thích
4,706
Giới tính
Nam
Có nhiều cách đọc tập tin pdf, ở đây tôi xin giới thiệu cách đọc tập tin pdf sử dụng công cụ xpdfreader.
http://www.xpdfreader.com/download.html
Trong ví dụ sau tôi sử dụng pdftotext (tức là chuyển pdf sang tập tin text) và sau đó sẽ đưa vào Excel.
1, Đầu tiên các bạn theo link trên tải về, giải nén và copy tập tin pdftotext.exe vào thư mục có chứa tập tin pdf muốn đọc.
2, Thay đổi các thông số ở sheet Setting trong tập tin Excel tôi upload lên cho phù hợp với yêu cầu của mình.
3, Thử chạy bằng việc nhấn vào nút Lấy dữ liệu cũng trong sheet Setting. Kết quả sẽ đưa vào sheet Result.

Code sau:
Rich (BB code):
'---------------------------------------------------------------------------------------
' Method : MoFilePdf
' Author : Doit
' Date   : 07/04/2019
' Purpose: Nham doc file pdf va dua vao Excel
'
'          Tai pdftotext tai http://www.xpdfreader.com/download.html
'          Tham khao tai lieu tai http://www.xpdfreader.com/pdftotext-man.html
'---------------------------------------------------------------------------------------
Sub MoFilePdf()

    Dim sFolderPath As String, sBatFileName As String, sPdfFileName As String, sTxtFileNamePath As String
    Dim sPdfExeFolder As String, sTxtFileName As String, FileNumber As Integer, sData As String
    Dim lRow As Long
    Dim PID As Variant
    Dim wsSetting As Worksheet, wsResult As Worksheet

    On Error GoTo MoFilePdf_Error

    ' Nham tang toc do thuc hien
    Application.EnableEvents = False    'Disable Excel Events
    Application.ScreenUpdating = False    'Turn Off Screen Updating to eliminate Screen Flicker and to improve speed performance

    ' Lay ten cac tap tin
    '=====================
    Set wsSetting = ThisWorkbook.Worksheets("Setting")
    Set wsResult = ThisWorkbook.Worksheets("Result")
    sFolderPath = wsSetting.Range("E2")
    sPdfFileName = wsSetting.Range("E3")
    sBatFileName = wsSetting.Range("E4")
    sTxtFileName = wsSetting.Range("E5")
    sTxtFileNamePath = sFolderPath & "\" & sTxtFileName
    sPdfExeFolder = wsSetting.Range("E6")

    ' Tao tap tin bat
    '=================
    FileNumber = FreeFile
    Open sBatFileName For Output As #FileNumber
    ' Chuyen ve thu muc tap tin pdftotext.exe
    Print #FileNumber, "cd " & sPdfExeFolder
    ' Lenh ke tiep cho chay chuong trinh pdftotext.exe voi cac tham so thiet lap truoc
    ' Chu y: su dung Chr(34) cho dau ngoac kep
    Print #FileNumber, "pdftotext.exe -layout " & Chr(34) & sPdfFileName & Chr(34) & " " & Chr(34) & sTxtFileName & Chr(34)
    ' Lenh ke tiep la thoat
    Print #FileNumber, "exit"
    Close #FileNumber

    ' Thuc thi batFile
    ' ================
    PID = Shell(sBatFileName, vbNormalFocus)
    If Err.Number <> 0 Then
        ' Neu co loi thi di den bay loi va thong bao
        GoTo MoFilePdf_Error
    End If
    ' Tiep tuc dua du lieu ra sheet Result
    ' =====================================
    FileNumber = FreeFile
    ' Hang dau de xuat du lieu
    lRow = 1
    wsResult.Cells.Clear    ' Xoa du lieu truoc khi xuat ra
    Open sTxtFileNamePath For Input As FileNumber
    Do While Not EOF(FileNumber)
        Line Input #FileNumber, sData
        wsResult.Cells(lRow, 1) = sData
        lRow = lRow + 1
    Loop
    Close #FileNumber

    ' Neu thanh cong thi thong bao
    MsgBox "Ban da lay du lieu tu tap tin pdf thanh cong.", vbOKOnly, "Thong bao"

MoFilePdf_Exit:
    ' Giai phong bien/release memory
    Set wsSetting = Nothing
    Set wsResult = Nothing

    ' Tra lai tinh trang ban dau
    Application.EnableEvents = True    'Enable Excel Events
    Application.ScreenUpdating = True    'Enable Screen Updating
    Exit Sub

MoFilePdf_Error:
    ' vbCrLf la ky tu xuong dong
    MsgBox "Loi " & Err.Number & " (" & Err.Description & ")." & vbCrLf & "Vui long kiem tra lai.", vbOKOnly + vbInformation, "Thong bao"

End Sub

Trong code ở trên tôi có giải thích.

Hy vọng đây cũng là một ví dụ tham khảo giúp ích cho các bạn.

Lê Văn Duyệt
 

File đính kèm

  • ReadPdfFile.xlsm
    32.1 KB · Đọc: 214
Em chào anh,
Em đã chạy thử và bị báo lỗi ở chỗ này:
wShell.Run comm & Chr(34) & Arr(K) & Chr(34) & Chr(32) & Chr(34) & FileName & Chr(34), 0, -1
Và thông báo lỗi hiện lên như vậy: Run-time error -2147024894(80070002)': Method Run' of object lWshShell3 ' failed
Cũng với file đó em chạy thử trên 1 máy khác thì lại không bị, kết quả rất tốt. Loay hoay mãi mà vẫn chưa tìm ra được nguyên nhân, nhờ anh xem giúp em liệu lỗi có thể ở đâu vậy ạ.

View attachment 288488View attachment 288489
Mình copy code nhưng nhìn mãi k biết chạy như nào, lấy đường dẫn đến thư mục chứa các file pdf cần convert sao, Bạn chỉ giúp mình với
 
Upvote 0
Mình copy code nhưng nhìn mãi k biết chạy như nào, lấy đường dẫn đến thư mục chứa các file pdf cần convert sao, Bạn chỉ giúp mình với
Bạn thay đường dẫn các file PDF vào chỗ 1 2....... bên dưới, để sử dụng hiệu quả thì bạn phải xào chế code thêm 1 xíu.

Private Sub test_PDF2TXT_xPDF()
Dim Arr
Arr = Array("*1.pdf", "*2.pdf")
PDF2TXT_xPDF Arr
End Sub
 
Upvote 0
mình hỏi chút, code lúc bấm run thì k thấy code nào trong bảng run
b có thể giúp m sửa những chỗ nào k
code tổng quát quá nên mình cũng k biết sửa sao
 
Upvote 0
mình hỏi chút, code lúc bấm run thì k thấy code nào trong bảng run
b có thể giúp m sửa những chỗ nào k
code tổng quát quá nên mình cũng k biết sửa sao
Bạn thay dường dẫn vào rồi chạy cái sub này là được nè, mình cũng chỉ là sơ nhập VBA nên cũng đang bế tắc với vụ lỗi gặp phải, đang thử rẽ sang các hướng khác để tìm, hiện tại có rất nhiều website và phần mềm chuyển PDF sang TXT, bạn gõ google là có. Nếu không rành về VBA lắm thì tốt hơn nên đi vòng 1 xíu cũng được bạn ạ, vì muốn sử dụng hiệu quả code này bạn cũng phải biết chút ít VBA để chế thêm.

Private Sub test_PDF2TXT_xPDF()
Dim Arr
Arr = Array("*1.pdf", "*2.pdf")
PDF2TXT_xPDF Arr
End Sub
 
Upvote 0
Em chào anh,
Em đã chạy thử và bị báo lỗi ở chỗ này:
wShell.Run comm & Chr(34) & Arr(K) & Chr(34) & Chr(32) & Chr(34) & FileName & Chr(34), 0, -1
Và thông báo lỗi hiện lên như vậy: Run-time error -2147024894(80070002)': Method Run' of object lWshShell3 ' failed
Cũng với file đó em chạy thử trên 1 máy khác thì lại không bị, kết quả rất tốt. Loay hoay mãi mà vẫn chưa tìm ra được nguyên nhân, nhờ anh xem giúp em liệu lỗi có thể ở đâu vậy ạ.

View attachment 288488View attachment 288489
Tôi đã giải quyết được vấn đề của mình, chia sẻ cho bạn nào có gặp phải lỗi như tôi:
Nhấn tổ hợp phím Windows + R, gõ %temp%
Tìm thư mục Xpdf, nó sẽ có tên tương tự như xpdf-win-4.04, xóa luôn cả thư mục này.
Chạy lại code là được, khi chạy code sẽ tự cài đặt lại xpdf, có thể tôi bị lỗi chỗ cài đặt này trước đó nên máy tôi không chạy được code.
 
Upvote 0
Tôi đã giải quyết được vấn đề của mình, chia sẻ cho bạn nào có gặp phải lỗi như tôi:
Nhấn tổ hợp phím Windows + R, gõ %temp%
Tìm thư mục Xpdf, nó sẽ có tên tương tự như xpdf-win-4.04, xóa luôn cả thư mục này.
Chạy lại code là được, khi chạy code sẽ tự cài đặt lại xpdf, có thể tôi bị lỗi chỗ cài đặt này trước đó nên máy tôi không chạy được code.
Bác chạy được code của anh HeSanbi rồi ạ ?
 
Upvote 0
Vâng, code chạy tốt mà bạn, mình đã sử dụng nhiều code khác để chạy thử nhưng cuối cùng vẫn sử dụng mã code này, vì định dạng đầu ra rất phù hợp ý mình.
Code của anh HeSanbi cũng copy vào file macro của bác levanduyet phải không bạn
Khi copy code vào, bạn có thấy bị báo những dòng đỏ này k ạ ?
Bạn có thể cho mình xin liên lạc được không bạn, cám ơn bạn nhiều
1681265199740.png
 

File đính kèm

  • 1681265103369.png
    1681265103369.png
    145.1 KB · Đọc: 7
Upvote 0
Code của anh HeSanbi cũng copy vào file macro của bác levanduyet phải không bạn
Khi copy code vào, bạn có thấy bị báo những dòng đỏ này k ạ ?
Bạn có thể cho mình xin liên lạc được không bạn, cám ơn bạn nhiều
View attachment 288822
Khi copy code vào, bạn có thấy bị báo những dòng đỏ này k ạ ? -> Có nha bạn
Bạn lưu ý là code của anh Hesanbi hoặc anh Batman1 chỉ chuyển từ file PDF sang TXT, còn muốn chuyển vào file Excel thì bạn phải xào nấu thêm tùy nhu cầu của bạn.
Dưới đây là đoạn code củ chuối của mình, bạn copy vào, thay thế hoàn toàn Sub test_PDF2TXT_xPDF() cũ, sau đó chạy Sub test_PDF2TXT_xPDF() vừa mới paste vào, lúc này bạn có thể chọn một hoặc nhiều file PDF cần chuyển sang TXT. Sau đó hãy kiểm tra lại kết quả, sẽ có các file TXT mới tạo ra tương ứng với các file PDF được chọn trong cùng thư mục.

Mã:
Sub test_PDF2TXT_xPDF()
    Dim i As Integer
    Dim FilePaths As Variant
    Dim StrPaths As String
    FilePaths = Application.GetOpenFilename(filefilter:="PDF Files (*.pdf), *.pdf", MultiSelect:=True)
    If VarType(FilePaths) = vbBoolean Then Exit Sub
    For i = LBound(FilePaths) To UBound(FilePaths)
        StrPaths = StrPaths & Chr(34) & FilePaths(i) & Chr(34) & "|"
    Next i
    StrPaths = LEFT(StrPaths, Len(StrPaths) - 1)
    Dim Arr
    Arr = Split(StrPaths, "|")
    PDF2TXT_xPDF Arr
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Khi copy code vào, bạn có thấy bị báo những dòng đỏ này k ạ ? -> Có nha bạn
Bạn lưu ý là code của anh Hesanbi hoặc anh Batman1 chỉ chuyển từ file PDF sang TXT, còn muốn chuyển vào file Excel thì bạn phải xào nấu thêm tùy nhu cầu của bạn.
Dưới đây là đoạn code củ chuối của mình, bạn copy vào, thay thế hoàn toàn Sub test_PDF2TXT_xPDF() cũ, sau đó chạy Sub test_PDF2TXT_xPDF() vừa mới paste vào, lúc này bạn có thể chọn một hoặc nhiều file PDF cần chuyển sang TXT. Sau đó hãy kiểm tra lại kết quả, sẽ có các file TXT mới tạo ra tương ứng với các file PDF được chọn trong cùng thư mục.

Mã:
Sub test_PDF2TXT_xPDF()
    Dim i As Integer
    Dim FilePaths As Variant
    Dim StrPaths As String
    FilePaths = Application.GetOpenFilename(filefilter:="PDF Files (*.pdf), *.pdf", MultiSelect:=True)
    If VarType(FilePaths) = vbBoolean Then Exit Sub
    For i = LBound(FilePaths) To UBound(FilePaths)
        StrPaths = StrPaths & Chr(34) & FilePaths(i) & Chr(34) & "|"
    Next i
    StrPaths = LEFT(StrPaths, Len(StrPaths) - 1)
    Dim Arr
    Arr = Split(StrPaths, "|")
    PDF2TXT_xPDF Arr
End Sub
Cám ơn bác, em sửa phần code bác HeSanbi theo hướng dẫn ok rồi, file đã cho chạy chọn nhiều file PDF, và cũng bị lỗi như của bác, em thực hiện xóa trong temp như bác bảo rồi
Tuy nhiên chạy xong file bị Kaspersky quét virus xóa đi luôn :((

Để em thử mò qua code của bác Batman1 xem sao

"..
Em đã chạy thử và bị báo lỗi ở chỗ này:
wShell.Run comm & Chr(34) & Arr(K) & Chr(34) & Chr(32) & Chr(34) & FileName & Chr(34), 0, -1
Và thông báo lỗi hiện lên như vậy: Run-time error -2147024894(80070002)': Method Run' of object lWshShell3 ' failed"
1681280423464.png
 
Upvote 0
Cám ơn bác, em sửa phần code bác HeSanbi theo hướng dẫn ok rồi, file đã cho chạy chọn nhiều file PDF, và cũng bị lỗi như của bác, em thực hiện xóa trong temp như bác bảo rồi
Tuy nhiên chạy xong file bị Kaspersky quét virus xóa đi luôn :((

Để em thử mò qua code của bác Batman1 xem sao

"..
Em đã chạy thử và bị báo lỗi ở chỗ này:
wShell.Run comm & Chr(34) & Arr(K) & Chr(34) & Chr(32) & Chr(34) & FileName & Chr(34), 0, -1
Và thông báo lỗi hiện lên như vậy: Run-time error -2147024894(80070002)': Method Run' of object lWshShell3 ' failed"
View attachment 288852
Run-time error -2147024894(80070002) đó có thể là bạn không có đủ quyền để chạy. Bạn thử chuyển file pdf sang thư mục mới tạo ở ổ D xem.
 
Upvote 0
Run-time error -2147024894(80070002) đó có thể là bạn không có đủ quyền để chạy. Bạn thử chuyển file pdf sang thư mục mới tạo ở ổ D xem.

Em copy nhặt thêm code cho chọn nhiều file PDF đưa vào code của bác batman1, giờ chạy OK ra được nhiều file text, với đầy đủ dấu tiếng Việt rồi bác ạ

Các huynh có code nào chọn các file text này, đưa vào chỉ định cột F copy lần lượt nối tiếp vào giúp em với ạ

P/S: Em cũng đang dùng 1 code chạy copy text của pdf vào excel, nó hoạt động kiểu mở file pdf lên, copy nội dung, dán text vào file excel chỉ định tại 1 cột. Tuy nhiên việc bộ nhớ clip broad nó cứ bị trùng sau mỗi vòng, nên hay bị thiếu file hoặc trùng file text. Nên em thấy cách sử dụng ứng dụng pdftotext.exe theo cách của anh levanduyet và của anh batman1 sẽ không bị lỗi bộ nhớ clipboard copy

Sub Copy_HNX_PDF_multi()

Dim App_Path As String
Dim Pdf_path As Variant
Dim shell_path As String
Dim i As Variant
Dim lastrow As Long

Set MyWorksheet = ActiveWorkbook.Worksheets("TD.hnx+")
App_Path = "C:\Program Files (x86)\Adobe\Reader 9.0\Reader\AcroRd32.exe"
Pdf_path = Application.GetOpenFilename("Pdf Files (*.pdf), *.pdf", , "Select Statements", , True)

For i = LBound(Pdf_path) To UBound(Pdf_path)

shell_path = App_Path & " """ & Pdf_path(i) & """"
Call Shell(pathname:=shell_path, windowstyle:=vbNormalFocus)

Application.Wait Now + TimeValue("0:00:03")

SendKeys "%vpc"
SendKeys "^a"
SendKeys "^c"

With MyWorksheet
lastrow = .Cells(.Rows.Count, "F").End(xlUp).Row
End With

Range("F" & lastrow + 2).Select
ActiveWorkbook.Worksheets("TD.hnx+").PasteSpecial Format:="Unicode Text"
Application.CutCopyMode = False

Next i

With MyWorksheet
.Range("G6:AD6").Copy Destination:=.Range("G7:AD" & [F100000].End(xlUp).Row)
Application.CutCopyMode = False
End With

Call Shell("TaskKill /F /IM AcroRd32.exe", vbHide)

MsgBox "Hoàn Thành"

End Sub


1681284027916.png1681283210086.png1681284108364.png
P
 

File đính kèm

  • 1_20230407_chi_tiet_gd_tu_doanh_theo_ma_ck_up_12042023133050.txt
    774 bytes · Đọc: 5
  • 1_20230407_chi_tiet_gd_tu_doanh_theo_ma_ck_ny_12042023133050.txt
    864 bytes · Đọc: 4
  • 1_20230406_chi_tiet_gd_tu_doanh_theo_ma_ck_up_12042023133050.txt
    904 bytes · Đọc: 3
  • 1_20230406_chi_tiet_gd_tu_doanh_theo_ma_ck_ny_12042023133050.txt
    889 bytes · Đọc: 4
Upvote 0
Em copy nhặt thêm code cho chọn nhiều file PDF đưa vào code của bác batman1, giờ chạy OK ra được nhiều file text, với đầy đủ dấu tiếng Việt rồi bác ạ

Các huynh có code nào chọn các file text này, đưa vào chỉ định cột F copy lần lượt nối tiếp vào giúp em với ạ

P/S: Em cũng đang dùng 1 code chạy copy text của pdf vào excel, nó hoạt động kiểu mở file pdf lên, copy nội dung, dán text vào file excel chỉ định tại 1 cột. Tuy nhiên việc bộ nhớ clip broad nó cứ bị trùng sau mỗi vòng, nên hay bị thiếu file hoặc trùng file text. Nên em thấy cách sử dụng ứng dụng pdftotext.exe theo cách của anh levanduyet và của anh batman1 sẽ không bị lỗi bộ nhớ clipboard copy
Đúng rồi. Bạn dùng code của Batman1 đi. Tôi dùng thấy ổn.
 
Upvote 0
Mấy cái dữ liệu chứng khoán này lấy trực tiếp bằng API ấy, tải tập tin PDF về rồi nhặt ra kiểu gì cũng bị rơi chữ. Công mò lại cũng quá tội.
vâng bác, hiện mấy cái dữ liệu này các cty chứng khoán họ công bố ra theo dạng pdf cho nhà đầu tư kiểu đó tải về
API hình như không có cho cái dữ liệu pdf này..mà thú thực em cũng không hiểu API, trình em vẫn chỉ cố xào nấu trên excel bóc tách ra nếu có data copy vào thôi

Cứ có text copy vào excel là em tách được lên số e cần

1681285852698.png
 
Upvote 0
vâng bác, hiện mấy cái dữ liệu này các cty chứng khoán họ công bố ra theo dạng pdf cho nhà đầu tư kiểu đó tải về
API hình như không có cho cái dữ liệu pdf này..mà thú thực em cũng không hiểu API, trình em vẫn chỉ cố xào nấu trên excel bóc tách ra nếu có data copy vào thôi

Cứ có text copy vào excel là em tách được lên số e cần

View attachment 288868
Mấy cái file của bạn cấu trúc dữ liệu có giống nhau hoàn toàn không, ví dụ có cùng số dòng.
Nếu giống nhau thì bạn copy và nối vào excel như đang làm cũng được, còn nếu khác nhau thì mình hay cho tất cả dữ liệu của mỗi file vào từng ô, sau đó viết công thức gắp dữ liệu cần lấy ra, cũng giống kiểu bạn đang làm.
 
Lần chỉnh sửa cuối:
Upvote 0
Mấy cái file của bạn cấu trúc dữ liệu có giống nhau hoàn toàn không, ví dụ có cùng số dòng.
Nếu giống nhau thì bạn copy và nối vào excel như đang làm cũng được, còn nếu khác nhau thì mình hay cho tất cả dữ liệu của mỗi file vào từng ô, sau đó viết công thức gắp dữ liệu cần lấy ra, cũng giống kiểu bạn đang làm.
Đúng rồi bạn, mình có hàm tách bên phải rồi
Nếu có code import text files vào cột F thì sẽ đỡ thêm 1 bước copy tay từng file text vào file excel đích
 
Lần chỉnh sửa cuối:
Upvote 0
Đúng rồi bạn, mình có hàm tách bên phải rồi
Nếu có code import text files vào cột F thì sẽ đỡ thêm 1 bước copy tay từng file text vào file excel đích

Bạn thử chạy code bên dưới, chọn các file TXT cần lấy dữ liệu để đưa vào Excel, sau đó kiểm tra lại kết quả xem sao.

Mã:
Sub ABC()
    Dim X As FileDialog
    Dim Y As Variant
    Dim Row As Long
    Set X = Application.FileDialog(msoFileDialogFilePicker)
    X.Filters.Clear
    X.Filters.Add "Text files", "*.txt"
    X.AllowMultiSelect = True
    If X.Show = True Then
        For Each Y In X.SelectedItems
            Open Y For Input As #1
            Do Until EOF(1)
                Line Input #1, TextLine
                Row = ActiveSheet.Cells(Rows.Count, 6).End(xlUp).Row + 1
                Cells(Row, 6).Value = TextLine
            Loop
            Close #1
        Next Y
    End If
End Sub
 
Upvote 0
Bạn thử chạy code bên dưới, chọn các file TXT cần lấy dữ liệu để đưa vào Excel, sau đó kiểm tra lại kết quả xem sao.
Cám ơn bạn rất nhiều, text data copy vào excel được rồi bạn, tuy bị mất dấu tiếng Việt nhưng phần data quan trọng cần dùng là ok rồi bạn ah

1681290046709.png
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom