Excel 通过VBA嵌入pdf

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

由于尝试了Application.SendKeys，我不知所措，但它是在解析OLEObjects.Add方法之后执行的，而不是在解析过程中执行的。谢谢你的帮助

Sub-OLE\u-Objects\u-Fix（）
将OLE设置为Excel.OLEObject
将OLE设置为Excel.OLEObjects
Dim Xl作为新的Excel.Application
将Ws设置为Excel.Worksheet
将Wb设置为Excel.工作簿
Dim目录路径、文件名、文件路径为字符串
尺寸为Excel.Range
设置Rng=汇总范围（“A1”）
dirPath=“C:\Users\me\Desktop\…\Models\”
fileName=VBA.Dir（dirPath，vbNormal）
带Xl码
.Visible=True
而文件名为“”
如果VBA.Left（文件名，9）=“唯一标识符”，则
调试.打印文件名
设置Wb=.Workbooks.Open（dirPath和fileName，False，False）
对于Wb.工作表中的每个Ws
Ws.Activate
设置Rng=Rng偏移量（1,0）
如果Ws.Name=Rng.Offset（0，1）.Value，则
filePath=Rng.Offset（0,3）.Value
如果结束
对于Ws.OLEObjects中的每个OLE
删除
下一个OLE
如果文件路径为“”，则
Debug.Print Ws.Name:Debug.Print文件路径
设置OLEs=Ws.OLEObjects
设置OLE=OLE。添加（_
fileName:=文件路径_
链接：=假_
DisplayAsIcon:=假_
左：=Ws.范围（“F1”）。左_
顶部：=Ws.范围（“F1”）.顶部）
如果结束
下一个Ws
filePath=“”
Wb.Close（正确）
如果结束
fileName=VBA.Dir
温德
以
端接头

请尝试，用此代码替换添加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或直接从注册表中提取API。我将仅为第一种方式展示一个示例：

通过以下方式调整代码以创建对象：

   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 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

---

但是，您只使用Excel对象在哪个程序中工作？您需要在哪里手动粘贴文件路径？@FaneDuru我正在Excel中工作。当我在OLEObjects.Add方法中使用ClassType参数时，它会打开一个文件对话框并要求我选择一个文件。我尝试过使用Application.SendKeys，但它是在方法解析后执行的，而不是在我需要的过程中执行的。然后，

Dim Xl作为新的Excel。Application

是一种奇怪的方法。。。无论如何，如果您的对象将作为图标嵌入，这会是一个问题吗？我问的目的是…@FaneDuru我正在使用一个新的excel实例来打开这些工作簿，因为我不希望用户看到OLE对象正在更新。如果我使用Excel的活动实例，他们的用户输入可能会搞糟一些事情。只要文档仍然打开且没有错误，我就不用担心将项目显示为图标。确定。然后试试这个：事实上，我会发布一个答案。你不会明白的，在这里，在评论中…我明白你想做什么。我看了一下，我的C:\WINDOWS\Installer\目录不包含{AC76BA86-7AD7-1033-7B44-AB0000000001}文件夹。我将搜索PDFFileIcon文件。我找到了图标文件并运行了代码，但它返回了1004错误，“无法添加对象”。我也尝试过为IconIndex插入一个参数0或1，但它并没有解决它。它对我有效。。。我在很多时候都使用这种嵌入方式。使用完全相同的IconFileName路径进行四次以上的安装。。。不检查它是否存在，或者它可能是另一个…请尝试在安装程序文件夹中搜索“pdffile”…尝试将该ico文件（在同一文件夹中）替换为

SC\u Reader.ico

。。。

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