Adding hyperlinks and text to speaker notes section within PowerPoint using VBA

Question

I'm trying to loop through all the slides in a PowerPoint and add the associated text for the links and the full hyperlink to the notes section.

I've been successful in making that happen, but now I get a "Run-time error '-21247188160 (80048240)'. In my research folks have suggested adding a timer/DoEvent to the code within the loop section as it can stumble a bit. That unfortunately didn't work.

Any ideas?

Sub AddHyperlinksWithNameToNotes()

   Dim vSlide As Slide
   Dim vHyperlink As Hyperlink
   Dim sLinks As String
   Dim vShape As Shape
   
   
    For Each vSlide In ActivePresentation.Slides
        For Each vHyperlink In vSlide.Hyperlinks
            sLinks = sLinks _
                & vHyperlink.TextToDisplay _
                & ": " & vHyperlink.Address _
                & vbCrLf
        Next
        vSlide.NotesPage.Shapes(2).TextFrame.TextRange = ""
        vSlide.NotesPage.Shapes(2).TextFrame.TextRange.Text = sLinks
        sLinks = ""
    Next
End Sub

Thanks!

Answer 1

As written in the documentation, hyperlinks in PP may be of 2 types: msoHyperlinkRange and msoHyperlinkShape - see https://learn.microsoft.com/ru-ru/office/vba/api/powerpoint.hyperlink.type. So hyperlink of msoHyperlinkShape hasn't TextToDisplay.

Try to check vHyperlink.Type:

Sub AddHyperlinksWithNameToNotes()

    Dim vSlide As Slide
    Dim vHyperlink As Hyperlink
    Dim sLinks As String
    Dim vShape As Shape
    
    For Each vSlide In ActivePresentation.Slides
        For Each vHyperlink In vSlide.Hyperlinks
            
            If vHyperlink.Type = msoHyperlinkRange Then ' check type
                ttd = vHyperlink.TextToDisplay
            Else
                ttd = "LinkOnShape"
            End If
            
            sLinks = sLinks _
                & ttd _
                & ": " & vHyperlink.Address _
                & vbCrLf
        Next
        vSlide.NotesPage.Shapes(2).TextFrame.TextRange = ""
        vSlide.NotesPage.Shapes(2).TextFrame.TextRange.Text = sLinks
        sLinks = ""
    Next
End Sub