PDA

View Full Version : [SOLVED:] Extracting hyperlink and text info from Powerpoint



h2whoa
11-29-2016, 10:32 AM
I have a massive slide deck (978 slides). Nearly every slide has at least 1 hyperlink on it. I have a code that extracts every single hyperlink into a text file, reporting:



Slide number
Whether the link is embedded in text or a shape
What shape it occurs in
What the url is


So the current report I get reads as: (for example)


Slide: 3
HYPERLINK IN SHAPE
Shape: Freeform 11
Address: example1URL

Slide: 4
HYPERLINK IN TEXT
Shape: Text Box 2
Address: example2URL

I now need to show what the actual text is that has been hyperlinked (or the text in the shape that has been hyperlinked) in between points 3 and 4. I'm sure that's a relatively simple fix, but I just can't get it to work. The original code that produces the 4 point report is below. If someone can help me with what I need to add to get the text, I'd be eternally grateful!


Sub ExtractHyperlinks()
Dim oS1 As Slide
Dim oH1 As Hyperlink
Dim sReport As String
Dim iFileNum As Integer
Dim sFileName As String
For Each oS1 In ActivePresentation.Slides
For Each oH1 In oS1.Hyperlinks
If oHl.Type = msoHyperlinkShape Then
If oHl.Address <> "" Then
sReport = sReport & "HYPERLINK IN SHAPE" _
& vbCrLf _
& "Slide: " & vbTab & oS1.SlideIndex _
& vbCrLf _
& "Shape: " & oH1.Parent.Parent.Name _
& vbCrLf _
& "Address:" & vbTab & oHl.Address & vbCrLf & vbNewLine

Else
sReport = sReport & ""
End If

Else
If oH1.Address <> "" Then
sReport = sReport & "HYPERLINK IN TEXT" _
& vbCrLf _
& "Slide: " & vbTab & oS1.SlideIndex _
& vbCrLf _
& "Shape: " & oH1.Parent.Parent.Parent.Parent.Name _
& vbCrLf _
& "Address:" & vbTab & oHl.Address & vbCrLf & vbNewLine

Else
sReport = sReport & ""
End If
End If
Next
Next
iFileNum = FreeFile()
sFileName = Environ("USERPROFILE") & "\Desktop\Report.txt"
Open sFileName For Output As iFileNum
Print #iFileNum, sReport
Close #iFileNum
Call Shell("NOTEPAD.EXE " & sFileName, vbNormalFocus)
End Sub

h2whoa
11-30-2016, 03:24 AM
Well, I kept chugging away at this out of pig-headedness. If anyone's interested, here's the code I eventually developed that works! There might be a nicer way to do it, but this does work.


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 = Environ("USERPROFILE") & "\Desktop\Report.txt"
Open sFileName For Output As iFileNum
Print #iFileNum, sReport
Close #iFileNum
Call Shell("NOTEPAD.EXE " & sFileName, vbNormalFocus)
End Sub

John Wilson
11-30-2016, 07:37 AM
You might want to credit the author of virtually all of "your" code though.

Just saying

https://answers.microsoft.com/en-us/msoffice/forum/msoffice_powerpoint-mso_other/powerpoint-find-all-hyperlinks/1d83cd15-1be0-40f2-9130-62ff78fac6bd

h2whoa
11-30-2016, 09:02 AM
You might want to credit the author of virtually all of "your" code though.

Just saying

https://answers.microsoft.com/en-us/msoffice/forum/msoffice_powerpoint-mso_other/powerpoint-find-all-hyperlinks/1d83cd15-1be0-40f2-9130-62ff78fac6bd

Fair point, and I didn't mean to take credit for this as "my" code. I'm not a coder, so everything I manage to do is from hatcheting code from what I can find in online examples. As a non-coder who just throws mud at the wall to see what sticks to fit my purposes, I don't feel any ownership over what I manage to splodge together in VBA, and I certainly don't try and take any credit.

I only posted this in case the changes I've managed to make are useful to anyone else, as I couldn't find this particular variant out there. Like I say, I'm genuinely not trying to take credit, just posting something I thought was useful.