Outlook 2007 Search Through E-Mail

[LMS]

There was no error message...it just turned yellow.....I will try what you said right now

 

[LMS]

There was no error message...it just turned yellow.....I will try what you said right now

 

[LMS]

There was no error message...it just turned yellow.....I just tried it and same yellow and did not do it....not if after the words Folders I put in the name of the folder as a ("Name").Items....that goes to the specific folder...but I want it to simply search all folders

 

[LMS]

update please?

 

[Diane Poremsky]

So it sounds like its not pointing at the right folder. I'll have to sleep on it.

 

[LMS]

Any update today please

 

[LMS]

Just in case this will show you what to tell me.....this is a code that someone gave me, that when I run it from the top macro, it displays all contacts from every where I think....so is there something to put in this so it only displays the contact of the email address from the note field of the received email....or is there anything from this code, to add to your code so it does it for all folders?

Sub GetValueUsingRegEx39()
Dim obj As Object
Dim Selection As Selection
Dim olMail As Object 'Outlook.MailItem
Dim Reg1 As Object
Dim M1 As Object
Dim M As Object
Dim strAddress As String
Dim myContacts As Items
Dim myItem As contactItem
Set Selection = Application.ActiveExplorer.Selection
Set objNS = Application.GetNamespace("MAPI")
processFolder (objNS.GetDefaultFolder(olFolderContacts))
End Sub
Private Sub processFolder(ByVal oParent As outlook.MAPIFolder)
Dim oFolder As outlook.MAPIFolder
Dim oContact As outlook.contactItem
For Each oContact In oParent.Items
oContact.Display
Next
If (oParent.Folders.Count > 0) Then
For Each oFolder In oParent.Folders
Call processFolder(oFolder)
Next
End If
End Sub

 

[Diane Poremsky]

The processFolder sub should work if you can work it in - it checks all of the folders.

Try this one -

Sub GetValueUsingRegEx3() 
Dim obj As Object 
Dim Selection As Selection 
Dim olMail As Object 'Outlook.MailItem 
Dim Reg1 As Object 
Dim M1 As Object 
Dim M As Object 
Dim strAddress As String 
Dim myContacts As Items 
 
Set Selection = Application.ActiveExplorer.Selection 
 
For Each obj In Selection 
Set olMail = obj 
Set Reg1 = CreateObject("VBScript.RegExp") 
With Reg1 
.Pattern = "(([\w-\.]*\@[\w-\.]*)\s*)" 
.IgnoreCase = True 
.Global = False 
End With 
 
If Reg1.TEst(olMail.Body) Then 
 
Set M1 = Reg1.Execute(olMail.Body) 
For Each M In M1 
strAddress = M.SubMatches(1) 
Debug.Print strAddress 
processFolder (objNS.GetDefaultFolder(olFolderContacts)) 
 
Next 
 
End If 
Next 
End Sub 
 
Private Sub processFolder(ByVal oParent As outlook.MAPIFolder) 
 
Dim oFolder As outlook.MAPIFolder 
Dim oContact As outlook.contactItem 
Dim myItem As contactItem 
 
For Each oContact In oParent.Items 
Set myItem = oContacts.Find("[Email1Address]=" & strAddress) 
   myItem.Display 
Next 
If (oParent.Folders.Count > 0) Then 
For Each oFolder In oParent.Folders 
Call processFolder(oFolder) 
Next 
End If 
End Sub

 

[LMS]

Thanks much. When I ran it, it did not do it and the following line turns yellow with know specific error:

processFolder (objNS.GetDefaultFolder(olFolderContacts))

And also, when I move my mouse to that line, is shows that str.addresss = the email address in the note field of the email I received.

 

[LMS]

Update re what I told you please?

 

[LMS]

Update please?

 

[LMS]

Update please?

 

[Diane Poremsky]

it's mothers day and i took the weekend off. i looked at it yesterday and it's definitely something with the processfolder line, but i don't know what is wrong, sorry.

 

[LMS]

If you can figure it out that would be great. Happy Mothers Day!

 

[LMS]

Update please....I really need to do this!!!

 

[LMS]

Update please....I really need to do this!!!

 

[LMS]

Update please?

 

[Diane Poremsky]

try this - i have no idea if it works on subfolders as i don't use subfolders, but it definitely finds the match in the contacts folder.

Dim strAddress As String 
Sub GetValueUsingRegEx3() 
Dim obj As Object 
Dim Selection As Selection 
Dim olMail As Object 'Outlook.MailItem 
Dim Reg1 As Object 
Dim M1 As Object 
Dim M As Object 
 
Set objNS = Application.GetNamespace("MAPI") 
Set Selection = Application.ActiveExplorer.Selection 
 
For Each obj In Selection 
Set olMail = obj 
Set Reg1 = CreateObject("VBScript.RegExp") 
With Reg1 
.Pattern = "(([\w-\.]*@[\w-\.]*)\s*)" 
.IgnoreCase = True 
.Global = False 
End With 
 
If Reg1.test(olMail.Body) Then 
 
Set M1 = Reg1.Execute(olMail.Body) 
For Each M In M1 
strAddress = M.SubMatches(1) 
Debug.Print strAddress & " " & Time 
processFolder (objNS.GetDefaultFolder(olFolderContacts)) 
 
Next 
 
End If 
Next 
End Sub 
 
Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder) 
Dim oFolder As Outlook.MAPIFolder 
Dim oContact As Outlook.ContactItem 
On Error Resume Next 
For Each oContact In oParent.Items 
  If oContact.Email1Address = strAddress Then 
    oContact.Display 
  End If 
Next 
If (oParent.Folders.Count > 0) Then 
For Each oFolder In oParent.Folders 
Call processFolder(oFolder) 
Next 
End If 
End Sub

 

[LMS]

I moved Dim strAddress As String below the Sub title.....and when I ran it, it simply opens up all contacts

 

[Forum Admin]

You need it outside the macro because you are passing the straddress value to the processfolder sub -
For Each oContact In oParent.Items
If oContact.Email1Address = strAddress Then