Question

我无法在Excel中打开我的pdf文件。我写了一个宏来打开一个pdf文档，复制所有内容并将其粘贴到excel工作簿中，但我无法打开pdf文件。我一直收到1004运行时错误。任何帮助的想法将不胜感激。这是我到目前为止所尝试的：

Public Sub PDFCopy()

Dim o As Variant
Dim App As AcroPDDoc
Worksheets("Sheet3").Range("A2").Activate

'App.Open ("C:\NetworkDiagrams\100-Viking.pdf")
o = Shell("calc.exe", vbNormalNoFocus)
' ActiveWorkbook.FollowHyperlink ("C:\NetworkDiagram\100-Viking.pdf")

Application.Wait Now + TimeValue("00:00:05")
SendKeys ("^a")
SendKeys ("^c")
SendKeys "%{F4}"

Worksheets("Sheet3").Range("A2").Activate

SendKeys ("^v")



End Sub

这三种方法都给了我相同的运行时错误。我没有想法。

Answer 1

有两种方法可以做到这一点。

首先，您需要知道系统中安装了什么 Acrobat与Acrobat或Adobe Reader不同。

如果您只有Acrobat Reader，这是代码。您使用Shell功能然后复制PDF的内容，使用SendKeys 一种脏代码并不是100％可靠，但我可以说它仍然有效。

Sub Get_Pdf()
    Dim XLName As String, PDFPath As String, READERPath As String
    Dim OpenPDF, sh As Worksheet

    XLName = ThisWorkbook.Name
    Set sh = Thisworkbook.Sheets(1)
    PDFPath = Application.GetOpenFilename(filefilter:="PDF file (*.pdf), *.pdf")
    If UCase(PDFPath) = "FALSE" Then Exit Sub
    '~~> Below path differs depending Adobe version and installation path
    READERPath = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe "
    Shell READERPath & PDFPath, vbNormalFocus: DoEvents

    Application.Wait Now + TimeValue("00:00:2")

    SendKeys "^a", True
    Application.Wait Now + TimeValue("00:00:2")

    SendKeys "^c"
    Application.Wait Now + TimeValue("00:00:2")

    Windows(XLName).Activate
    sh.Paste sh.Range("A1")
    SendKeys "%{F4}", True
End Sub

如果您已安装Acrobat，请参阅this帖子并检查正确答案上发布的链接。
链接上发布了更新，即使只安装了ADOBE阅读器，也会打开PDF。

Answer 2

不确定这是否适合您，但它会打开PDF并将其复制到A2中;希望有人可以用更清洁的东西来填充。

Public Sub PDFCopy()

    'Filepath for your Adobe reader
    MyPath = "C:\Program Files\Adobe\Reader 10.0\Reader\AcroRd32.exe"
    'Filepath for your PDF to open
    MyFile = "C:\Documents\test.pdf"
    Shell MyPath & " " & MyFile, vbNormalFocus

    SendKeys ("^a")
    SendKeys ("^c")
    SendKeys "%{F4}"

    Windows("Test.xlsm").Activate
    Worksheets("Sheet2").Activate
    ActiveSheet.Range("A2").Select

    SendKeys ("^v")

End Sub

使用VBA在Excel中打开PDF文件

2 个答案: