I am trying to programatically embed PDF files to specific worksheets. When I embed using the ClassType variable "Adobe.Document.2015", the file opens without problems, however, I have to manually paste in the filepath. When I embed using the filename argument of OLEObjects.Add, I can do it programmatically, however, when the user opens the PDF document embedded this way, they get an error message on the Acrobat side. This message does not appear when adding through the ClassType argument of OLEObjects.Add. Is there a way to use both ClassType and Filename arguments so I don't have to manually paste the file paths?
I am at a loss as I have attempted Application.SendKeys but it is executed after the OLEObjects.Add method is resolved, not during. Appreciate any help.
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
Try, please, replacing your piece of code for adding OLEObject with this one and let me know if it is well open:
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")
A second version not needing the icon path. It uses the (installed) exe path. And it also shows the associated application icon. There are two ways of doing that. Using API or extracting it directly from Registry. I will show a sample only for the first way:
Adapt your code to create the OLEObject in this way:
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)")
Put the API function on top of your module (in the declarations part):
Private Declare PtrSafe Function FindExecutable Lib "shell32.dll" _
Alias "FindExecutableA" (ByVal lpFile As String, _
ByVal lpDirectory As String, ByVal lpResult As String) As Long
And copy the function able to retrieve the associated application path:
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