通过 VBA 嵌入 PDF

Question

我正在尝试以编程方式将 PDF 文件嵌入到特定工作表中。当我使用 ClassType 变量 "Adobe.Document.2015" 嵌入时，文件打开时没有问题，但是，我必须手动粘贴到文件路径中。当我使用 OLEObjects.Add 的文件名参数嵌入时，我可以通过编程方式进行嵌入，但是，当用户打开以这种方式嵌入的 PDF 文档时，他们会在 Acrobat 端收到一条错误消息。通过 OLEObjects.Add 的 ClassType 参数添加时不会出现此消息。有没有办法同时使用 ClassType 和 Filename 参数，这样我就不必手动粘贴文件路径了？

我已经尝试过Application.SendKeys，但它是在 OLEObjects.Add 方法解析之后执行的，而不是在解析期间执行的。感谢任何帮助。

Adobe Acrobat Error Message

Sub OLE_Objects_Fix()

Dim OLE As Excel.OLEObject
Dim OLEs As Excel.OLEObjects

Dim Xl As New Excel.Application
Dim Ws As Excel.Worksheet
Dim Wb As Excel.Workbook
Dim dirPath, fileName, filePath As String
Dim Rng As Excel.Range

Set Rng = Summary.Range("A1")

dirPath = "C:\Users\me\Desktop\...\Models\"
fileName = VBA.Dir(dirPath, vbNormal)

With Xl
    .Visible = True
    While fileName <> ""
        If VBA.Left(fileName, 9) = "unique identifier" Then
            Debug.Print fileName
            Set Wb = .Workbooks.Open(dirPath & fileName, False, False)
                For Each Ws In Wb.Worksheets
                    Ws.Activate
                    Set Rng = Rng.Offset(1, 0)
                    If Ws.Name = Rng.Offset(0, 1).Value Then
                        filePath = Rng.Offset(0, 3).Value
                    End If
                    For Each OLE In Ws.OLEObjects
                        OLE.Delete
                    Next OLE
                        If filePath <> "" Then
                            Debug.Print Ws.Name: Debug.Print filePath
                            Set OLEs = Ws.OLEObjects
                            Set OLE = OLEs.Add( _
                            fileName:=filePath, _
                            Link:=False, _
                            DisplayAsIcon:=False, _
                            Left:=Ws.Range("F1").Left, _
                            Top:=Ws.Range("F1").Top)
                        End If
                Next Ws
            filePath = ""
            Wb.Close (True)
        End If
        fileName = VBA.Dir
    Wend

End With

End Sub

Answer 1

请尝试，用这段代码替换您添加 OLEObject 的代码，让我知道它是否正常打开：

Set OLE = OLEs.Add( _
    fileName:=filePath, _
    Link:=False, _
    DisplayAsIcon:=True, _
    IconFileName:= _
     "C:\Windows\Installer\{AC76BA86-1033-FFFF-7760-0E0F06755100}\_SC_Acrobat.ico", _
     IconIndex:=0, _
     IconLabel:="Click to open the " & Ws.Name & " PDF file")

不需要图标路径的第二个版本。它使用（已安装的）exe 路径。并且它还显示关联的应用程序图标。有两种方法可以做到这一点。使用 API 或直接从注册表中提取。我将仅展示第一种方式的示例：

调整您的代码以这样创建 OLEObject：

   exePath = exeApp(filePath)

    Set OLE = ws.OLEObjects.Add( _
            fileName:=filePath, _
            link:=False, _
            DisplayAsIcon:=True, _
            IconFileName:=exePath, _
            left:=ws.Range("F1").left, _
            top:=ws.Range("F1").top, _
            IconIndex:=0, IconLabel:="Embeded PDF (your name)")

将 API 函数放在模块顶部（在声明部分）：

Private Declare PtrSafe Function FindExecutable Lib "shell32.dll" _
                 Alias "FindExecutableA" (ByVal lpFile As String, _
                 ByVal lpDirectory As String, ByVal lpResult As String) As Long

并复制能够检索关联应用程序路径的函数：

 Private Function exeApp(strFile As String) As String
       Const MAX_FILENAME_LEN = 260
       Dim i As Long, buff As String

       If strFile = "" Or Dir(strFile) = "" Then
          MsgBox "File not found!", vbCritical
          Exit Function
       End If
       'Create a buffer
       buff = String(MAX_FILENAME_LEN, 32)
       'Retrieve the name and handle of the executable
       i = FindExecutable(strFile, vbNullString, buff)
       If i > 32 Then
          exeApp = left$(buff, InStr(buff, Chr$(0)) - 1)
       Else
          MsgBox "No association found, for this file !"
       End If
    End Function

通过 VBA 嵌入 PDF

Embedding PDFs through VBA

excel

acrobat

vba