VBA 宏报告PowerPoint幻灯片上的链接

Question

I am trying to modify some code to retrieve any links in powerpoint slides and print them to a document. I am struggling to get the objects.

Here is what I have already:

Sub LinkCounter()
    Dim FileNum As Integer
    Dim oFile As String
    Dim textLink() As Shape, i As Long
    
    
    FileNum = FreeFile()
    oFile = ActivePresentation.Path & "\LinksReport.txt"
    If Dir(oFile, vbNormal) <> vbNullString Then
        Kill oFile
    End If


i = 0
p = 1

Open oFile For Append As #FileNum
    Print #FileNum, "Links counted on slides"
For Each Slide In ActivePresentation.Slides
Print #FileNum, "Slide"; p
p = p + 1

    For Each Hyperlinks.Address In Slide.Hyperlinks

               Set textLink(i) = Hyperlinks.Address
               Print #FileNum, textLink(i)
               i = i + 1
Next Hyperlinks.Address

Next Slide


Close FileNum

End Sub

Any help would be appreciated!

Answer 1

After some deeper searching I found a piece of code that achieves this, it would be good to know where I went wrong however, I'm guessing I need to loop through shapes to find the links?

Sub PPHyperlinkReport()
Dim oSl As Slide
Dim oHl As Hyperlink
Dim sReport As String
Dim iFileNum As Integer
Dim sFileName As String
For Each oSl In ActivePresentation.Slides
For Each oHl In oSl.Hyperlinks
If oHl.Type = msoHyperlinkShape Then
If oHl.Address <> "" Then
sReport = sReport & "HYPERLINK IN SHAPE" _
& vbCrLf _
& "Slide: " & vbTab & oSl.SlideIndex _
& vbCrLf _
& "Shape: " & vbTab & oHl.Parent.Parent.Name _
& vbCrLf _
& "Text: """ & oHl.Parent.Parent.TextFrame.TextRange.Text & """" _
& vbCrLf _
& "External link address:" & vbTab & oHl.Address & vbCrLf & vbNewLine & vbNewLine

Else
sReport = sReport & ""
End If

Else
If oHl.Address <> "" Then
sReport = sReport & "HYPERLINK IN TEXT" _
& vbCrLf _
& "Slide: " & vbTab & oSl.SlideIndex _
& vbCrLf _
& "Shape: " & vbTab & oHl.Parent.Parent.Parent.Parent.Name _
& vbCrLf _
& "Text: """ & oHl.Parent.Parent.Text & """" _
& vbCrLf _
& "External link address:" & vbTab & oHl.Address & vbCrLf & vbNewLine & vbNewLine

Else
sReport = sReport & ""
End If
End If
Next ' hyperlink
Next ' Slide
iFileNum = FreeFile()
sFileName = ActivePresentation.Path & "\AuthorTec_Edits.txt"
Open sFileName For Output As iFileNum
Print #iFileNum, sReport
Close #iFileNum
Call Shell("NOTEPAD.EXE " & sFileName, vbNormalFocus)
End Sub