Problem calling .shape object in PPT from excel

Question

I am trying to combine 2 sets of code that both work individually but when combined I get a ""run-time error "-214767259 (80004005) method 'AddOLEObject' of object 'Shapes' failed"". The first code simply loops through all pdf's in a file.

Sub LoopPDFFiles()
    
    Dim sFilePath As String
    Dim sFileName As String
    
    sFilePath = "C:\Users\hareb\Desktop\Work Tracker\Test\"
       
    sFileName = Dir(sFilePath & "*.pdf")
    
    Do While Len(sFileName) > 0
    
        If Right(sFileName, 3) = "pdf" Then
            Debug.Print sFileName
        End If
        
        sFileName = Dir
        
    Loop
   
End Sub

The second one opens a new PPT, adds a slide, inserts a image of a pdf, then saves the slide as a gif and closes the PPT.

Sub ConvertPDFtoGIF()

Dim OriginalPath As String
Dim NewPath As String
Dim NewPPT As Object
Dim PDFWidth As Single
Dim PDFHeight As Single
Dim sh As Object
Dim PPTPres As Object

OriginalPath = "C:\Users\hareb\Desktop\Work Tracker\Test\3763A1010100003112022 - Copy (2).pdf"
NewPath = "C:\Users\hareb\Desktop\Work Tracker\Test\Test\TestGIF.GIF"

PDFWidth = 8.5 * 72
PDFHeight = 11 * 72

Set NewPPT = CreateObject("Powerpoint.application")

NewPPT.Visible = True

Set PPTPres = NewPPT.presentations.Add

PPTPres.Slides.AddSlide 1, PPTPres.SlideMaster.CustomLayouts(1)

    With PPTPres.PageSetup
        .SlideWidth = PDFWidth
        .SlideHeight = PDFHeight
    End With

Set sh = PPTPres.Slides(1)

sh.Shapes.AddOLEObject 0, 0, PDFWidth, PDFHeight, , OriginalPath

Call PPTPres.Slides(1).Export(NewPath, "GIF")

NewPPT.Quit

End Sub

The combination set of code refuses to work and I can't understanding of why. The error occurs in the middle of the IF statement on the sh.shapes line.

Sub PDFLoop()
    
Dim sFilePath As String
Dim sFileName As String
Dim nFileName As String
Dim NewPPT As Object
Dim PDFWidth As Single
Dim PDFHeight As Single
Dim sh As Object
Dim PPTPres As Object

sFilePath = "C:\Users\hareb\Desktop\Work Tracker\Test\"
       
sFileName = Dir(sFilePath & "*.pdf")
nFileName = Dir(sFilePath & "test\" & "*.gif")
    
PDFWidth = 8.5 * 72
PDFHeight = 11 * 72


Set NewPPT = CreateObject("Powerpoint.application")

NewPPT.Visible = True

Set PPTPres = NewPPT.presentations.Add

    With PPTPres.PageSetup
        .SlideWidth = PDFWidth
        .SlideHeight = PDFHeight
    End With

PPTPres.Slides.AddSlide 1, PPTPres.SlideMaster.CustomLayouts(1)

Set sh = PPTPres.Slides(1)
            
    
    Do While Len(sFileName) > 0

        If Right(sFileName, 3) = "pdf" Then
            sh.Shapes.AddOLEObject 0, 0, PDFWidth, PDFHeight, , sFileName
        End If
            
        Call PPTPres.Slides(1).Export(nFileName, "GIF")
        
        sh.Shapes.Delete
        
        sFileName = Dir
        
    Loop
   
End Sub

Answer 1

need to replace this line

sh.Shapes.AddOLEObject 0, 0, PDFWidth, PDFHeight, , sFileName

with this

sh.Shapes.AddOLEObject 0, 0, PDFWidth, PDFHeight, , sFilePath & "\" & sFileName

If your are on mac or your OS uses different path separator use that path separator instead of "" . Or you can enable Excel library and use Application.PathSperator