Option Explicit
'Attribute VB_Name = "McRitchie_decode_html_text"
'Designed for personal use to convert HTML code to plain text showing tags
' for use in HTML code samples.
'based on makehtml_link which you can find in
' http://www.mvps.org/dmcritchie/excel/code/makehtml_link.txt
'this code in
' http://www.mvps.org/dmcritchie/excel/code/decode_html.txt
' is referenced in a Firefox page
' http://www.mvps.org/dmcritchie/firefox/copyurl.htm
Sub decode_html_text()
' David McRitchie 2005-07-15 decode_HTML_text
'---' D '----' identify large letter D on toolbar icon for this link
' based on Dana DeLouis 2001-03-19 misc, using an
' Idea From: Chip Pearson
' http://www.cpearson.com/excel/clipboar.htm
'= = = = = = = = =
' VBA Lib.Ref.: Microsoft Forms 2.0 object lib.
' Excel 2000 due to Replace() Function.
'= = = = = = = = =
'The following might become related to this
' http://www.screaminet.com/~tswirsky/transurl.htm#DLArea
' TransURL - URL Translation Utility
'= = = = = = = = =
Dim MyDataObj As New DataObject
MyDataObj.GetFromClipboard
Dim slnk As String, pLnk As String, vLnk As String
Dim Skip3 As String
Skip3 = vbCr & vbCr & vbCr
slnk = MyDataObj.GetText
slnk = Replace(slnk, "&", "&")
slnk = Replace(slnk, Chr(160), " ")
slnk = Replace(slnk, "<", "<")
slnk = Replace(slnk, ">", ">")
slnk = Replace(slnk, Chr(34), """)
slnk = Replace(slnk, "\n", "\n")
slnk = Replace(slnk, vbCrLf, "<+$br$+>")
slnk = Replace(slnk, vbCr, "<+$br$+>")
slnk = Replace(slnk, vbLf, "<+$br$+>")
slnk = Replace(slnk, "<+$br$+>", vbCrLf & "
")
On Error GoTo failure
MyDataObj.SetText slnk
On Error Resume Next
MyDataObj.PutInClipboard
If Err.number <> 0 Then GoTo failure
vLnk = MyDataObj.GetText
If Err.number <> 0 Or vLnk <> slnk Then
pLnk = InputBox("mission control, we've " _
& "lost the paste: " & slnk & Chr(13) & Chr(13) & vLnk, "Reference", slnk)
End If
Set MyDataObj = Nothing
done:
Beep
Exit Sub
failure:
On Error GoTo 0
slnk = InputBox("Failed to get to decode_html_text, please extract your link" _
& "from here: " & slnk & Chr(13) & pLnk, "Reference", slnk)
End Sub