An earlier version of this procedure was posted on the Outlook board. This is version 2.0. It will pop up a Note showing the link text and URL for one or more open HTML messages, or for messages selected in a mail folder. Still imperfect, it's really part of my half-blind exploration of the Outlook object model. Maybe it will be useful to someone else as well.
<pre>
Private intNoteCount As Integer

Sub LinkLister()
'Copyright 2001 Jefferson Scher - 3/17/01
'Check whether one or more messages or other OL items is open and proceed
' accordingly
intNoteCount = 0 'module level integer variable
Select Case Inspectors.Count
Case 0 'no items are open, but it might be a mail folder
If ActiveExplorer.Selection.Count = 0 Then
MsgBox "Select or open an HTML message first, then try again."
Else 'one or more items are selected in this folder
If ActiveExplorer.Selection.Item(1).Class = olMail Then
Dim aMsg As MailItem, bolNoHTML As Boolean
bolNoHTML = True
For Each aMsg In ActiveExplorer.Selection
If aMsg.HTMLBody <> vbNullString Then
Call LinksToNote(aMsg)
bolNoHTML = False
End If
Next
If bolNoHTML Then
MsgBox "None of the selected messages is HTML."
End If
Else
MsgBox "This lister works only in a mail folder."
Exit Sub
End If
End If
Case 1 'check only the open item
If ActiveInspector.EditorType <> olEditorHTML Then
MsgBox "Not an HTML message."
Exit Sub
Else
Call LinksToNote(ActiveInspector.CurrentItem)
End If
Case Else 'iterate through mutiple open items
Dim anInsp As Inspector
Dim msgArray() As MailItem, intCount As Integer
ReDim msgArray(1 To 5)
intCount = 0
For Each anInsp In Inspectors
If anInsp.EditorType = olEditorHTML Then
intCount = intCount + 1
If intCount <= 5 Then
Set msgArray(intCount) = anInsp.CurrentItem
Else
ReDim Preserve msgArray(1 To intCount)
Set msgArray(intCount) = anInsp.CurrentItem
End If
End If
Next
If intCount = 0 Then
MsgBox "No HTML messages to examine."
Exit Sub
Else
For intCount = 1 To UBound(msgArray())
If msgArray(intCount) Is Nothing Then Exit For
Call LinksToNote(msgArray(intCount))
Next
End If
End Select
End Sub

Sub LinksToNote(myMailItem As MailItem)
'Copyright 2001 Jefferson Scher - 3/17/01
Dim strCodeArray() As String
strCodeArray = Split(myMailItem.HTMLBody, "href=", , vbTextCompare)
If UBound(strCodeArray()) = 0 Then
If Inspectors.Count = 1 Then
MsgBox "No links found in """ & myMailItem.Subject & """"
End If
Set myMailItem = Nothing
Exit Sub
End If
Dim strNoteBody As String, intCount As Integer, intFirstGT
Dim myNote As NoteItem
Set myNote = CreateItem(olNoteItem)
myNote.Width = 600
myNote.Height = 500
strNoteBody = "Links in -> " & myMailItem.Subject & vbCrLf & "(From -> "
strNoteBody = strNoteBody & myMailItem.SenderName & " - at - "
strNoteBody = strNoteBody & myMailItem.SentOn & ")"
Set myMailItem = Nothing
For intCount = 1 To UBound(strCodeArray())
strCodeArray(intCount) = Replace(strCodeArray(intCount), vbCrLf, " ")
intFirstGT = InStr(1, strCodeArray(intCount), ">")
strNoteBody = strNoteBody & vbCrLf & vbCrLf & _
"Desc: " & Mid(strCodeArray(intCount), _
intFirstGT + 1, InStr(1, strCodeArray(intCount), "</a>", _
vbTextCompare) - (intFirstGT + 1)) & vbCrLf
strNoteBody = strNoteBody & "URL: " & Mid(strCodeArray(intCount), 2, _
intFirstGT - 3)
Next
'hey you - delete spaces in the first quoted strings after % and &
strNoteBody = Replace(strNoteBody, "% 20", " ")
strNoteBody = Replace(strNoteBody, "& nbsp ;", " ", , , vbTextCompare)
strNoteBody = Replace(strNoteBody, "", vbNullString, , , vbTextCompare)
strNoteBody = Replace(strNoteBody, "
", vbNullString, , , vbTextCompare)
strNoteBody = Replace(strNoteBody, "", vbNullString, , , vbTextCompare)
strNoteBody = Replace(strNoteBody, "", vbNullString, , , vbTextCompare)
strNoteBody = Replace(strNoteBody, "
", vbNullString, , , vbTextCompare)
While InStr(1, strNoteBody, " ") 'replace double spaces with single
strNoteBody = Replace(strNoteBody, " ", " ")
Wend
myNote.Body = strNoteBody
myNote.Display
intNoteCount = intNoteCount + 1
myNote.Left = ((intNoteCount - 1) * 20) + 10
myNote.Top = ((intNoteCount - 1) * 40) + 20
Set myNote = Nothing
End Sub
</pre>