VBA to rename exported slides

[ta91888]

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:


Option Explicit
Const ImageBaseName As String = "Slide_"
Const ImageWidth As Long = 1920
Const ImageHeight As Long = 1080
Const ImageType As String = "PNG"

Function fileExists(s_directory As String, s_fileName As String) As Boolean

Dim obj_fso As Object

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

End Function

Sub ExportSlides()

Dim oSl As Slide
Dim Path As String
Dim File As String
Dim i As Long

If ActivePresentation.Path = "" Then
MsgBox "Please save the presentation then try again"
Exit Sub
End If

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

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

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

With ActivePresentation.SectionProperties
For i = 1 To .Count
For Each oSl In ActivePresentation.Slides
If Not 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
End If
If Not fileExists(Path, File) Then
oSl.Export Path & "\" & File, ImageType, ImageWidth, ImageHeight
End If
Next
Next
End With
End Sub

[John Wilson]

Try this a start to your 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

[ta91888]

This works like a dream! Thank you so much.

[ta91888]

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