none
Outlook 2007 Macro Search Contacts In Sent E-Mails RRS feed

  • Question

  • Here is the following code that takes care of searching contacts in all folders, sub folders, sub sub folders based on the email address given to me in a email message note field.....so instead of searching the contact folders, using the email address in the note field of the email message I receive, what to change so it just automatically searches the Outlook Sent E-mails re that email I received?

    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

    Thursday, May 22, 2014 10:15 PM

Answers

  • Hi,

    you could use Application.NewMailEx Event to get all Emails when a new mail item is received in the Inbox.

    Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
        Dim varEntryIDs
        Dim objItem
        Dim i As Integer
        varEntryIDs = Split(EntryIDCollection, ",")
        For i = 0 To UBound(varEntryIDs)
            Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
                        
            ‘Debug.Print "NewMailEx " & objItem.Subject
            'have found the received email, do what you want to do
        Next
    End Sub
    
    Hope this helps.

    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, May 26, 2014 9:48 AM
    Moderator

All replies

  • Hello Imseaz,

    >  using the email address in the note field of the email message I receive

    Actually the code iterates over selected mail items in Outlook, not only received. You can try to select items in the Sent Mail folder and run your code.

    Or you can use the following code:

    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 folder As Outlook.folder
      Dim items As Outlook.items
     Set objNS = Application.GetNamespace("MAPI")
     'Set Selection = Application.ActiveExplorer.Selection
      
     'For Each obj In Selection
     Set folder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
      Set items = folder.items
     For Each obj in items
     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


    Friday, May 23, 2014 8:00 AM
  • The code you gave just opens up all contacts on the default contact folder....that's not what I asked for help on.....anyone else that understands what I asked about?
    Friday, May 23, 2014 2:28 PM
  • Hi,

    you could use Application.NewMailEx Event to get all Emails when a new mail item is received in the Inbox.

    Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
        Dim varEntryIDs
        Dim objItem
        Dim i As Integer
        varEntryIDs = Split(EntryIDCollection, ",")
        For i = 0 To UBound(varEntryIDs)
            Set objItem = Application.Session.GetItemFromID(varEntryIDs(i))
                        
            ‘Debug.Print "NewMailEx " & objItem.Subject
            'have found the received email, do what you want to do
        Next
    End Sub
    
    Hope this helps.

    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, May 26, 2014 9:48 AM
    Moderator