PPT converteren naar JPG in eigen map

Option Explicit

Public Sub PresentationsToImages()

    Dim lngPresentations As Long
    Dim strImageName As String
    Dim strImagePath As String
    Dim strPresentationName As String
    Dim strPresentationPath As String
    Dim objSlide As Object

    On Error Resume Next

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
        For lngPresentations = 1 To .SelectedItems.Count
            strPresentationPath = .SelectedItems(lngPresentations)
            Presentations.Open strPresentationPath, msoTrue
            With ActivePresentation
                strPresentationName = Split(.Name, ".")(0)
                strImagePath = .path
                For Each objSlide In .Slides
                    With objSlide
                        strImageName = strPresentationName & "-" & Format(.SlideIndex, "000") & ".jpg"
                        .Export strImagePath & "\" & strImageName, "JPG"
                    End With
                Next
                .Close
            End With
        Next
    End With
    
    MsgBox "Presentations exported as images."
    
End Sub

Option Explicit

Public Sub PresentationsToImages()

    Dim lngPresentations As Long
    Dim strImageName As String
    Dim strImagePath As String
    Dim strPresentationName As String
    Dim strPresentationPath As String
    Dim objSlide As Object

    On Error Resume Next

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
        For lngPresentations = 1 To .SelectedItems.Count
            strPresentationPath = .SelectedItems(lngPresentations)
            Presentations.Open strPresentationPath, msoTrue
            With ActivePresentation
                strPresentationName = Split(.Name, ".")(0)
               [COLOR=#ff0000] strImagePath = .Path & "\" & strPresentationName
                If Dir(strImagePath, vbDirectory) = "" Then
                    MkDir strImagePath
                End If[/COLOR]
                For Each objSlide In .Slides
                    With objSlide
                        strImageName = strPresentationName & "-" & Format(.SlideIndex, "000") & ".jpg"
                        .Export strImagePath & "\" & strImageName, "JPG"
                    End With
                Next
                .Close
            End With
        Next
    End With

    MsgBox "Presentations exported as images."

End Sub

Sub M_snb()
  With Application.FileDialog(1)
    .AllowMultiSelect = True
    .InitialFileName = "G:\Powerpoint\*.ppt"
    .Show
    For Each it In .SelectedItems
      With GetObject(it)
        For Each it1 In .slides
         it1.Export .Path & "" & .Name & Format(it1.slideIndex, "_000") & ".jpg", "jpg"
        Next
       .Close
     End With
   Next
  End With
End Sub