Actually, I am trying this code:

Private Sub FindSaveAddressInEmails()
On Error Resume Next
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objItem As Object
Dim strFind As String
Dim objItems As Outlook.Items

Dim objSch As Search
Dim strF As String
Dim strS As String
Dim strTag As String

Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If objFolder Is Nothing Then Exit Sub

Set objItems = objFolder.Items

For Each objItem In objItems

strS = "undeliverables"
strF = "urn:schemas:httpmail:body LIKE '' & * & ''"
strTag = "EmailSearch"
objSch = Application.AdvancedSearch(strS, strF, False, strTag)

' objItem.Save
Next

MsgBox "Finished.", vbOKOnly + vbInformation

Set objNS = Nothing
Set objFolder = Nothing
Set objItem = Nothing
Set objItems = Nothing
End Sub


--
Phantom Researcher


"Edward" wrote:

Hello,
I have an Outlook folder full of undeliverable emails. I am trying to
develop a macro that will go to the folder, open each email, extract the
reported failed address frm the body of the email, and save the address to a
file. The failed address regularly appears in angle brackets in the body of
the message.

I can't seem to identify the best approach to this. Can you tell me what
I'm doing wrong, or if there is a more straitforward approach. I tried an
advanced search, but it stalls on the command line. I need to get this to
work so I can install the loop, and add a file location in which to save the
addresses located in the body of the messages. Currently it's a form with
one button:

Private Sub CommandButton1_Click()

Dim objSch As Search
Dim strF As String
Dim strS As String
Dim strTag As String

strS = "undeliverables"
strF = "urn:schemas:httpmail:body LIKE '' & * & ''"
strTag = "EmailSearch"
' TODO: Replace Application with the declared and set
' Outlook Application object
objSch = Application.AdvancedSearch(strS, strF, False, strTag)


End Sub
--
Phantom Researcher