VBA to rename exported slides

Hello,

I am trying to use VBA to find a solution to a file naming issue. I would like to export each slide in my presentation to PNG format with a predetermined name. I know that I can export to PNG and get a folder of slides such as Slide1.PNG, Slide2. PNG, etc. However, I would like these slides to be renamed to the title of the slide upon export (if slide title is Markets, I would like the exported PNG file to say Markets.PNG not Slide1.PNG).

I am very new to VBA and am trying to alter some code for a similar problem I found online but am having a lot of trouble processing this in my newbie brain. Here is the link URL for the code: "https://stackoverflow.com/questions/37716196/vba-to-export-images-from-powerpoint-with-section-and-title-as-filename"

I appreciate any help and guidance! Thank you in advance.

And here is the actual code I am working on:

Code:

---

Option Explicit
Const ImageBaseName AsString="Slide_"
Const ImageWidth AsLong=1920
Const ImageHeight AsLong=1080
Const ImageType AsString="PNG"

Function fileExists(s_directory AsString, s_fileName AsString)AsBoolean

    Dim obj_fso AsObject

    Set obj_fso = CreateObject("Scripting.FileSystemObject")
    fileExists = obj_fso.fileExists(s_directory &"\"& s_fileName)

EndFunction

Sub ExportSlides()

    Dim oSl As Slide
    Dim Path AsString
    Dim File AsString
    Dim i AsLong

    If ActivePresentation.Path =""Then
        MsgBox "Please save the presentation then try again"
        ExitSub
    EndIf

    Application.FileDialog(msoFileDialogFolderPicker).ButtonName ="Select Path"

    Path = GetSetting("FPPT","Export","Default Path")

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect =False
        .Title ="Select destination folder"
        If.Show =-1And.SelectedItems.Count =1Then
            Path =.SelectedItems(1)
        Else:ExitSub
        EndIf
    EndWith

    With ActivePresentation.SectionProperties
        For i =1To.Count
            ForEach oSl In ActivePresentation.Slides
                IfNot oSl.Shapes.HasTitle Then
                    File =.Name(i)& ImageBaseName & Format(oSl.SlideIndex,"0000")&"."& ImageType
                    Else: File =.Name(i)& oSl.Shapes.Title.TextFrame.TextRange.Text & Format(oSl.SlideIndex,"0000")&"."& ImageType
                EndIf
                IfNot fileExists(Path, File)Then
                    oSl.Export Path &"\"& File, ImageType, ImageWidth, ImageHeight
                EndIf
            Next
        Next
    EndWith
EndSub




---

Try this a start to your code:

Code:

---

Sub export_Slides()
Dim osld As Slide
Dim strFolder As String
Dim strPath As String


strFolder = Environ("USERPROFILE") & "\Desktop\SlideImages\"
On Error Resume Next
Err.Clear
MkDir strFolder
If Err <> 0 Then
If MsgBox("That folder already exists. Do you want to continue?", vbOKCancel) = vbCancel Then Exit Sub
End If
For Each osld In ActivePresentation.Slides
If osld.Shapes.HasTitle Then
If osld.Shapes.Title.TextFrame.HasText Then
strPath = strFolder & osld.Shapes.Title.TextFrame.TextRange & ".PNG"
Else
strPath = strFolder & "Slide_" & CStr(osld.SlideIndex) & ".PNG"
End If
Else
strPath = strFolder & "Slide_" & CStr(osld.SlideIndex) & ".PNG"
End If
Call osld.Export(strPath, "PNG")
Next osld
End Sub

---

This works like a dream! Thank you so much.

If I wanted that the images are saved into branched folders, would this be able to handle it? Any help would again be appreciated.