I need to parse for URLs incoming mail from a specific sender and to
automatically run Internet Explorer on those URLs.

Any help out there?

Hello,

I have an old code snippet here and do not know, if it still works. Try
it and fit it to your requirements:

Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias
"ShellExecuteA" _
(ByVal Hwnd As Long, ByVal lpOperation As String, ByVal lpFile As
String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal
nShowCmd As Long) As Long
Public Sub OpenHyperlink()


'================================================= ========================================
' Searching for Links in new mails and open them

'================================================= ========================================

' Show and activate the browser window
Const SW_SHOWNORMAL As Long = 1

' Senderaddress
Const SENDER As String = "



'-----------------------------------------------------------------------------------------
' Variables

'-----------------------------------------------------------------------------------------
Dim objInBox As Outlook.MAPIFolder ' Inbox
Dim objItems As Outlook.Items ' All mails
from senderaddress
Dim objItem As Object ' One single
mail

Dim strBody As String ' mail content
Dim strLink As String ' Hyperlink
Dim strFilter As String ' Filter

Dim lngReturn As Long ' Returnvalue
of "ShellExexute"


'-----------------------------------------------------------------------------------------
' Does not work on saturday (god`s sabbat)

'-----------------------------------------------------------------------------------------
If Format(Date, "DDDD") = "Saturday" Then Exit Sub


'-----------------------------------------------------------------------------------------
' Reference the inbox

'-----------------------------------------------------------------------------------------
Set objInBox = Nothing
Set objInBox = Outlook.session.GetDefaultFolder(olFolderInbox)


'-----------------------------------------------------------------------------------------
' Reference all mails from senderaddress

'-----------------------------------------------------------------------------------------
strFilter = "[SenderName] = """ & SENDER & """"
Set objItems = Nothing
Set objItems = objInBox.Items.Restrict(strFilter)


'-----------------------------------------------------------------------------------------
' No mails matching?

'-----------------------------------------------------------------------------------------
If objItems.Count = 0 Then Exit Sub


'-----------------------------------------------------------------------------------------
' Get the first item

'-----------------------------------------------------------------------------------------
Set objItem = Nothing
Set objItem = objItems.GetFirst


'-----------------------------------------------------------------------------------------
' Run all items

'-----------------------------------------------------------------------------------------
Do


'-------------------------------------------------------------------------------------
' Read the body

'-------------------------------------------------------------------------------------
strBody = objItem.Body


'-------------------------------------------------------------------------------------
' Get the hyperlink

'-------------------------------------------------------------------------------------
strLink = GetHyperlink(strBody)


'-------------------------------------------------------------------------------------
' Link found?

'-------------------------------------------------------------------------------------
If strLink "" Then


'---------------------------------------------------------------------------------
' Open link

'---------------------------------------------------------------------------------
lngReturn = ShellExecute(0, "open", strLink & vbNullChar,
vbNullString, _
vbNullString, SW_SHOWNORMAL)


'---------------------------------------------------------------------------------
' Delete the mail if open commando was successful

'---------------------------------------------------------------------------------
If lngReturn = 42 Then objItem.Delete

End If


'-------------------------------------------------------------------------------------
' Get the next item

'-------------------------------------------------------------------------------------
Set objItem = Nothing
Set objItem = GetNextItem(objItems)

Loop While Not objItem Is Nothing

End Sub
Private Function GetNextItem(objItems As Outlook.Items) As Object


'================================================= ========================================
' Returns the next item (if exists)

'================================================= ========================================

On Error Resume Next

Set GetNextItem = objItems.GetNext

End Function
Private Function GetHyperlink(ByVal strBody As String) As String


'================================================= ========================================
' Returns the first hyperlink in a mail (the hyperling have to be
on the beginning of a line)

'================================================= ========================================

Dim aryBody() As String
Dim intIndex As Integer


'-----------------------------------------------------------------------------------------
' Split body in rows

'-----------------------------------------------------------------------------------------
aryBody() = Split(strBody, vbCrLf)


'-----------------------------------------------------------------------------------------
' Does we have at least 1 row?

'-----------------------------------------------------------------------------------------
If UBound(aryBody()) -1 Then


'-------------------------------------------------------------------------------------
' Search the 1. hyperlink

'-------------------------------------------------------------------------------------
For intIndex = 0 To UBound(aryBody())


'---------------------------------------------------------------------------------
' Hyperlink found?

'---------------------------------------------------------------------------------
If Left(Trim(aryBody(intIndex)), 7) = "http://" Then


'-----------------------------------------------------------------------------
' Return hyperlink and get out

'-----------------------------------------------------------------------------
GetHyperlink = aryBody(intIndex): Exit Function

End If

Next

End If

End Function

--
Peter Marchert
[EDV-Service Marchert]
Homepage: http://www.marchert.de
Excel- und Outlookprogrammierung

Zigman53 schrieb:

I need to parse for URLs incoming mail from a specific sender and to
automatically run Internet Explorer on those URLs.

Any help out there?

Am 15 Oct 2006 06:02:56 -0700 schrieb Peter Marchert:

Wow, Peter! For sure you'll win this year`s competition of who posts the
most lines :-)

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.VBOffice.net --