无法使用VBA按顺序从PDF导出到Excel
我正在尝试将数据从PDF导出到Excel,我可以导出数据,但不能按顺序导出。下面是输入和输出 PDF文件无法使用VBA按顺序从PDF导出到Excel,vba,excel,excel-formula,Vba,Excel,Excel Formula,我正在尝试将数据从PDF导出到Excel,我可以导出数据,但不能按顺序导出。下面是输入和输出 PDF文件 我获得的实际输出 按顺序期望的预期输出 “Adobe Acrobat Reader”的位置(仅在不是默认PDF阅读器的情况下使用) Private Const AdobePDFReader As String=“C:\Program Files(x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe” '要测试的公共变量,如果我们成功地从PDF文档复制到E
我获得的实际输出
按顺序期望的预期输出
“Adobe Acrobat Reader”的位置(仅在不是默认PDF阅读器的情况下使用) Private Const AdobePDFReader As String=“C:\Program Files(x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe” '要测试的公共变量,如果我们成功地从PDF文档复制到Excel工作表 公共PDF2XL_成功作为布尔值 'API函数 #如果VBA7=False,则 私有声明函数FindExecutable Lib“shell32”别名“FindExecutableA”(ByVal lpFile作为字符串,ByVal lpDirectory作为字符串,ByVal lpResult作为字符串)长度为 私有声明函数DownloadURLToFile Lib“URLMon.DLL”别名“URLDownloadToFileA”(ByVal pCaller为Long,ByVal szURL为String,ByVal szFileName为String,ByVal dwReserved为Long,ByVal lpfnCB为Long)为Long #否则 私有声明PtrSafe函数FindExecutable Lib“shell32”别名“FindExecutableA”(ByVal lpFile作为字符串,ByVal lpDirectory作为字符串,ByVal lpResult作为字符串)长度为 Private Declare PtrSafe函数downloadtourltofile Lib“URLMon.DLL”别名“URLDownloadToFileA”(ByVal pCaller为长,ByVal szURL为字符串,ByVal szFileName为字符串,ByVal dwReserved为长,ByVal lpfnCB为长)为长 #如果结束 选项显式 子PDF2XL_测试() “*”初始化 出错时继续下一步 “*”定义变量 将PDFFile设置为字符串 PDFFile=“C:\Users\AntoDesktop\PA\PA Doc 1.pdf” “*”将PDF内容复制到活动Excel工作表 呼叫PDF2XL(PDFFile) “*”您可以在此处调整复制的内容 如果PDF2XL_Success=True,则应用程序运行“PDF2XL_调整” ES:潜艇结束 范围(“A1”)。选择 端接头 子PDF2XL(可选ByVal Pdfile As String=vbNullString,可选ByVal DestinationWorksheet As Excel.Worksheet) “*”初始化 出错时继续下一步 “*”定义变量 PDF2XL_成功=错误 如果TypeName(DestinationWorksheet)“工作表”,则设置DestinationWorksheet=ActiveSheet 如果Len(PDFFile)
'Location of 'Adobe Acrobat Reader' (only used, if it is not the default PDF reader)
Private Const AdobePDFReader As String = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"
' Public variable to test, if we were successful in copying from PDF document to Excel worksheet
Public PDF2XL_Success As Boolean
' API Functions
#If VBA7 = False Then
Private Declare Function FindExecutable Lib "shell32" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Private Declare Function DownloadURLToFile Lib "URLMon.DLL" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
Private Declare PtrSafe Function FindExecutable Lib "shell32" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
Private Declare PtrSafe Function DownloadURLToFile Lib "URLMon.DLL" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#End If
Option Explicit
Sub PDF2XL_Test()
' * ' Initialize
On Error Resume Next
' * ' Define variable
Dim PDFFile As String
PDFFile = "C:\Users\AntoDesktop\PA\PA Doc 1 Remedy.pdf"
' * ' Copy PDF contents to active Excel worksheet
Call PDF2XL(PDFFile)
' * ' Here you can adjust the copied contents
If PDF2XL_Success = True Then Application.Run "PDF2XL_Adjust"
ES: ' End of Sub
Range("A1").Select
End Sub
Sub PDF2XL(Optional ByVal PDFFile As String = vbNullString, Optional ByVal DestinationWorksheet As Excel.Worksheet)
' * ' Initialize
On Error Resume Next
' * ' Define variables
PDF2XL_Success = False
If TypeName(DestinationWorksheet) <> "Worksheet" Then Set DestinationWorksheet = ActiveSheet
If Len(PDFFile) < xlLess Or Len(Dir(PDFFile, vbHidden + vbSystem)) < 3 Then ' If no PDF document is given, then ask for one
PDFFile = Application.GetOpenFilename("PDF (*.PDF), *.PDF")
If Len(PDFFile) < xlLess Then GoTo ES: ' User clicked [Cancel]
End If
Dim FileAddressBuffer As String
FileAddressBuffer = Space$(260)
Dim FileHandle As Long
FileHandle = FindExecutable(Mid$(PDFFile, InStrRev(PDFFile, Application.PathSeparator) + 1), Left$(PDFFile, InStrRev(PDFFile, Application.PathSeparator)), FileAddressBuffer)
Dim PDFReader As String
If FileHandle >= 32 Then ' System has a PDF application installed
FileHandle = InStr(FileAddressBuffer, Chr$(0))
PDFReader = Left$(FileAddressBuffer, FileHandle - 1) ' Default PDF application of system
Else ' System does not have a PDF application installed
Select Case Application.LanguageSettings.LanguageID(2) ' Insert your own language below, if you want to
Case 1030, 1080: MsgBox "Could not locate PDF Reader on computer.", vbOKOnly + vbCritical, " PDF Reader"
Case Else: MsgBox "Could not locate PDF Reader on computer.", vbOKOnly + vbCritical, " PDF Reader"
End Select
GoTo ES:
End If
FileHandle = InStrRev(UCase$(PDFReader), "ADOBE")
If FileHandle > 0 Then
FileHandle = InStrRev(UCase$(PDFReader), "READER")
End If
If FileHandle < 1 Then ' The default PDF application is not 'Adobe PDF Reader'
If Len(Dir(AdobePDFReader)) < 5 Then ' The given PDF Reader in the constant in the declaration field can not be found
Select Case Application.LanguageSettings.LanguageID(2) ' Insert your own language below, if you want to
Case 1030, 1080: FileHandle = MsgBox("Den fundne PDF læser..." & vbNewLine & vbNewLine & PDFReader & vbNewLine & vbNewLine & "...ser ikke ud til at være 'Adobe Acrobat Reader'." & vbNewLine & vbNewLine & "Forsætte?", vbYesNo + vbExclamation, " PDF Reader")
Case Else: FileHandle = MsgBox("The found PDF reader..." & vbNewLine & vbNewLine & PDFReader & vbNewLine & vbNewLine & "...doesn't seems to be 'Adobe Acrobat Reader'." & vbNewLine & vbNewLine & "Continue?", vbYesNo + vbExclamation, " PDF Reader")
End Select
If FileHandle = vbNo Then GoTo ES:
Else
PDFReader = AdobePDFReader
End If
End If
PDFReader = Chr(34) & PDFReader & Chr(34) & " " & Chr(34) & Replace(PDFFile, Chr(34), vbNullString) & Chr(34)
' * ' Prepare worksheet
DestinationWorksheet.DisplayPageBreaks = False
DestinationWorksheet.Unprotect
If DestinationWorksheet.ProtectContents = True Then GoTo ES:
DestinationWorksheet.Visible = xlSheetVisible
If DestinationWorksheet.Visible <> xlSheetVisible Then GoTo ES:
DestinationWorksheet.Select
DestinationWorksheet.Cells.Delete
Range("A1").Select
' * ' Transfer PDF contents to Excel
Application.CutCopyMode = False ' Clear/reset Cut/Copy mode
Shell PDFReader, vbNormalFocus ' Open PDF document
Application.Wait Now + TimeValue("00:00:03") ' Wait a little to give document time to fully open
DoEvents
SendKeys "^a" ' Select all in PDF document
SendKeys "^c" ' Copy selected contents
Application.Wait Now + TimeValue("00:00:02") ' Wait a little to give clipboard time to copy (if huge contents)
DoEvents
SendKeys "^q" ' Close PDF document
Application.Wait Now + TimeValue("00:00:01") ' Wait a little to give document time to close completely
Application.Run "ActivateExcel", True ' Re-activate Excel in case another application was activate when closing PDF Reader
DoEvents
Err.Clear
DestinationWorksheet.Paste ' Paste PDF contents into worksheet
If Err.Number = 0 Then PDF2XL_Success = True
ES: ' End of Sub
Application.CutCopyMode = False ' Clear/reset Cut/Copy mode
Range("A1").Select
Set DestinationWorksheet = Nothing
'If TempFile <> vbNullString Then Kill TempFile
End Sub
Public Sub SplitAndTranspose()
Range("A1").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
TrailingMinusNumbers:=True
Range("A1", Range("A1").End(xlToRight)).Copy
Range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Rows(1).Delete Shift:=xlUp
Application.CutCopyMode = False
End Sub