Скорее всего, вам будет хорошо, если вы сначала преобразуете все файлы PDF в текстовые файлы и импортируете все данные из всех текстовых файлов в несколько листов в Excel.
Sub convertpdf2()
Dim AcroXApp As Acrobat.AcroApp
Dim AcroXAVDoc As Acrobat.AcroAVDoc
Dim AcroXPDDoc As Acrobat.AcroPDDoc
Dim Filename As String
Dim jsObj As Object
Dim NewFileName As String
Filename = "C:\your_path_here\test.pdf"
NewFileName = "C:\your_path_here\Desktop\test.txt"
Set AcroXApp = CreateObject("AcroExch.App")
'AcroXApp.Show
Set AcroXAVDoc = CreateObject("AcroExch.AVDoc")
AcroXAVDoc.Open Filename, "Acrobat"
Set AcroXPDDoc = AcroXAVDoc.GetPDDoc
Set jsObj = AcroXPDDoc.GetJSObject
jsObj.SaveAs NewFileName, "com.adobe.acrobat.plain-text"
AcroXAVDoc.Close False
AcroXApp.Hide
AcroXApp.Exit
End Sub
Или поместите все текстовые файлы на один лист в Excel, конечно, при условии, что все файлы имеют одинаковую схему.
Импортируйте несколько тестовых файлов на отдельные листы вExcel.
Sub CombineTextFiles()
'updateby Extendoffice 20151015
Dim xFilesToOpen As Variant
Dim I As Integer
Dim xWb As Workbook
Dim xTempWb As Workbook
Dim xDelimiter As String
Dim xScreen As Boolean
On Error GoTo ErrHandler
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
xDelimiter = "|"
xFilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "Kutools for Excel", , True)
If TypeName(xFilesToOpen) = "Boolean" Then
MsgBox "No files were selected", , "Kutools for Excel"
GoTo ExitHandler
End If
I = 1
Set xTempWb = Workbooks.Open(xFilesToOpen(I))
xTempWb.Sheets(1).Copy
Set xWb = Application.ActiveWorkbook
xTempWb.Close False
xWb.Worksheets(I).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:="|"
Do While I < UBound(xFilesToOpen)
I = I + 1
Set xTempWb = Workbooks.Open(xFilesToOpen(I))
With xWb
xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count)
.Worksheets(I).Columns("A:A").TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=False, Space:=False, _
Other:=True, OtherChar:=xDelimiter
End With
Loop
ExitHandler:
Application.ScreenUpdating = xScreen
Set xWb = Nothing
Set xTempWb = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description, , "Kutools for Excel"
Resume ExitHandler
End Sub
Если у вас установлен Acrobat, вы можете попробовать скрипт ниже.
Sub Convert_to_TXT()
Dim AcroXApp As Acrobat.AcroApp
Dim AcroXAVDoc As Acrobat.AcroAVDoc
Dim AcroXPDDoc As Acrobat.AcroPDDoc
Dim Filename As String
Dim jsObj As Object
Dim NewFileName As String
Const sPath = "C:\Users\Excel\Desktop\test\"
Const sExt = ".pdf"
Const dPath = "C:\Users\Excel\Desktop\test\"
Const dExt = ".txt"
Dim sName As String, dName As String, fCount As Long
'loop through all files in source
sName = Dir(sPath & "*" & sExt)
Do While sName <> ""
fCount = fCount + 1
'we have sName. Now figure out dName
dName = Left(sName, InStrRev(sName, ".") - 1) & dExt
Set AcroXApp = CreateObject("AcroExch.App")
'AcroXApp.Show
Set AcroXAVDoc = CreateObject("AcroExch.AVDoc")
AcroXAVDoc.Open sName, "Acrobat"
Set AcroXPDDoc = AcroXAVDoc.GetPDDoc
Set jsObj = AcroXPDDoc.GetJSObject
jsObj.SaveAs dName, "com.adobe.acrobat.plain-text"
'find the next file
sName = Dir
Loop
AcroXAVDoc.Close False
AcroXApp.Hide
AcroXApp.Exit
MsgBox "Found " & fCount & " files."
End Sub
Если у вас НЕ установлен Acrobat, вы можете попробовать скрипт ниже
Sub ConvertToTXT()
Dim file As Variant, wdDoc As Document
file = Dir("C:\your_path\" & "*.pdf") 'txt path
Do While (file <> "")
Set wdDoc = Documents.Open(Filename:="C:\your_path\" & file, ReadOnly:=True, _
AddToRecentFiles:=False, Format:=wdOpenFormatAuto, Visible:=False)
wdDoc.SaveAs2 Filename:="C:\your_path\" & Replace(file, ".pdf", ".txt"), _
FileFormat:=wdFormatPDF, AddToRecentFiles:=False
wdDoc.Close False
file = Dir
Loop
End Sub