VBA Split Presentation and save title from slide

[ThriveDesign]

Hello,
I have long/ large presentations that I split and archive in a slide library. The script I am currently using (John Wilson — pptalchemy.co.uk) creates the individual slides with generic file name with cumulative numbers. I'd like to run one macro to split and name the files with the 'Title' from each slide. I had limited success getting the 'Title' to be pulled from the presentation via – Shape("Title 1"). TextFrame. The files were created but did not split. I have the most basic grasp of VBA so any help would be greatly appreciated.

Sub SplitCards()
Dim i As Integer
Dim osource As Presentation
Dim otarget As Presentation
'SAVE A COPY
ActivePresentation.SaveCopyAs (Environ("TEMP") & "\tempfile.pptx")
Set osource = Presentations.Open(Environ("TEMP") & "\tempfile.pptx")
For i = osource.Slides.Count To 1 Step -1
osource.Slides(i).Copy
Set otarget = Presentations.Add(msoTrue)
otarget.Slides.Paste
'FOLLOW DESIGN
otarget.Slides(1).Design = osource.Slides(i).Design
otarget.Slides(1).ColorScheme = osource.Slides(i).ColorScheme
osource.Slides(i).Delete
'SAVE THE ONE SLIDE PRES
otarget.SaveAs (Environ("USERPROFILE") & "\Desktop\Slide " & CStr(i)) & sExt
otarget.Close
Set otarget = Nothing
Next i
osource.Close
'REMOVE THE TEMP FILE
Kill (Environ("TEMP") & "\tempfile.pptx")
Set osource = Nothing
End Sub

[John Wilson]

If the Titles are actually in Title Placeholders (ie real Titles)

Sub SplitCards()
Dim i As Integer
Dim osource As Presentation
Dim otarget As Presentation
Dim strName As String
'SAVE A COPY
ActivePresentation.SaveCopyAs (Environ("TEMP") & "\tempfile.pptx")
Set osource = Presentations.Open(Environ("TEMP") & "\tempfile.pptx")
For i = osource.Slides.Count To 1 Step -1
osource.Slides(i).Copy
Set otarget = Presentations.Add(msoTrue)
otarget.Slides.Paste
'FOLLOW DESIGN
otarget.Slides(1).Design = osource.Slides(i).Design
otarget.Slides(1).ColorScheme = osource.Slides(i).ColorScheme
strName = otarget.Slides(1).Shapes.Title.TextFrame.TextRange
osource.Slides(i).Delete
'SAVE THE ONE SLIDE PRES
otarget.SaveAs (Environ("USERPROFILE") & "\Desktop\" & strName & ".pptx")
otarget.Close
Set otarget = Nothing
Next i
osource.Close
'REMOVE THE TEMP FILE
Kill (Environ("TEMP") & "\tempfile.pptx")
Set osource = Nothing
End Sub

[ThriveDesign]

Thank you. When I run it skips the second slide. How can I fix that?

—Mark

[John Wilson]

Maybe the second slide has something in the Title that cannot be saved.

e.g. No Title at all
Blank Title
Title has a forbidden character

[ThriveDesign]

It only has the issue with the one deck. There is something off about that slide. Again, thank you!

[John Wilson]

Can you post just that slide somewhere (not an image the actual slide)