希望这可以帮助。我能够从文件夹的所有子文件夹中打开 pdf 文件,并使用上面推荐的 shell 将内容复制到启用宏的工作簿中。请参见下面的代码。
Sub ConsolidateWorkbooksLTD()
Dim adobeReaderPath As String
Dim pathAndFileName As String
Dim shellPathName As String
Dim fso, subFldr, subFlodr
Dim FolderPath
Dim Filename As String
Dim Sheet As Worksheet
Dim ws As Worksheet
Dim HK As String
Dim s As String
Dim J As String
Dim diaFolder As FileDialog
Dim mFolder As String
Dim Basebk As Workbook
Dim Actbk As Workbook
Application.ScreenUpdating = False
Set Basebk = ThisWorkbook
' Open the file dialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Show
MsgBox diaFolder.SelectedItems(1) & "\"
mFolder = diaFolder.SelectedItems(1) & "\"
Set diaFolder = Nothing
Set fso = CreateObject("Scripting.FileSystemObject")
Set FolderPath = fso.GetFolder(mFolder)
For Each subFldr In FolderPath.SubFolders
subFlodr = subFldr & "\"
Filename = Dir(subFldr & "\*.csv*")
Do While Len(Filename) > 0
J = Filename
J = Left(J, Len(J) - 4) & ".pdf"
Workbooks.Open Filename:=subFldr & "\" & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Set Actbk = ActiveWorkbook
s = ActiveWorkbook.Name
HK = Left(s, Len(s) - 4)
If InStrRev(HK, "_S") <> 0 Then
HK = Right(HK, Len(HK) - InStrRev(HK, "_S"))
Else
HK = Right(HK, Len(HK) - InStrRev(HK, "_L"))
End If
Sheet.Copy After:=ThisWorkbook.Sheets(1)
ActiveSheet.Name = HK
' Open pdf file to copy SIC Decsription
pathAndFileName = subFlodr & J
adobeReaderPath = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"
shellPathName = adobeReaderPath & " """ & pathAndFileName & """"
Call Shell( _
pathname:=shellPathName, _
windowstyle:=vbNormalFocus)
Application.Wait Now + TimeValue("0:00:2")
SendKeys "%vpc"
SendKeys "^a", True
Application.Wait Now + TimeValue("00:00:2")
' send key to copy
SendKeys "^c"
' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")
' activate this workook and paste the data
ThisWorkbook.Activate
Set ws = ThisWorkbook.Sheets(HK)
Range("O1:O5").Select
ws.Paste
Application.Wait Now + TimeValue("00:00:3")
Application.CutCopyMode = False
Application.Wait Now + TimeValue("00:00:3")
Call Shell("TaskKill /F /IM AcroRd32.exe", vbHide)
' send key to close pdf file
SendKeys "^q"
Application.Wait Now + TimeValue("00:00:3")
Next Sheet
Workbooks(Filename).Close SaveAs = True
Filename = Dir()
Loop
Next
Application.ScreenUpdating = True
End Sub
我编写了一段代码以从 pdf 和 csv 复制到启用宏的工作簿,您可能需要根据您的要求进行微调
问候, 赫玛·卡斯图里