VBA Macro to report links on powerpoint slides - vba

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