Find string in outlook

[sal21]

I need, with vba for excel, to find in Object and in Body Message the string Mystring="Test" in all emails in the folder TestMyDir and retrive the name of To:, possible with vba for excel?

[HansV]

You can use this as starting point:

Code: Select all

Sub FindMail()
    Dim strFind As String
    Dim strFolder As String
    Dim olApp As Object
    Dim olNsp As Object
    Dim olFld As Object
    Dim olItm As Object
    strFind = "Test" ' text to find
    strFolder = "TestMyDir" ' folder to search
    Set olApp = CreateObject(Class:="Outlook.Application")
    Set olNsp = olApp.GetNamespace("MAPI")
    Set olFld = olNsp.GetDefaultFolder(6).Parent.Folders(strFolder) ' 6 = olFoldersInbox
    For Each olItm In olFld.Items
        If TypeName(olItm) = "MailItem" Then
            If UCase(olItm.Subject) Like "*" & UCase(strFind) & "*" Or _
                    UCase(olItm.Body) Like "*" & UCase(strFind) & "*" Then
                Debug.Print olItm.SenderName
            End If
        End If
    Next olItm
    Set olFld = Nothing
    Set olNsp = Nothing
    Set olApp = Nothing
End Sub

I have assumed that the folder TestMyDir is a subfolder of your main Outlook mailbox.

[sal21]

You can use this as starting point:

Code: Select all

Sub FindMail()
    Dim strFind As String
    Dim strFolder As String
    Dim olApp As Object
    Dim olNsp As Object
    Dim olFld As Object
    Dim olItm As Object
    strFind = "Test" ' text to find
    strFolder = "TestMyDir" ' folder to search
    Set olApp = CreateObject(Class:="Outlook.Application")
    Set olNsp = olApp.GetNamespace("MAPI")
    Set olFld = olNsp.GetDefaultFolder(6).Parent.Folders(strFolder) ' 6 = olFoldersInbox
    For Each olItm In olFld.Items
        If TypeName(olItm) = "MailItem" Then
            If UCase(olItm.Subject) Like "*" & UCase(strFind) & "*" Or _
                    UCase(olItm.Body) Like "*" & UCase(strFind) & "*" Then
                Debug.Print olItm.SenderName
            End If
        End If
    Next olItm
    Set olFld = Nothing
    Set olNsp = Nothing
    Set olApp = Nothing
End Sub

I have assumed that the folder TestMyDir is a subfolder of your main Outlook mailbox.

WORK PERFECT!

But how to restrict the find match where the Year of recived mail is ="2014"?

[HansV]

Change

Code: Select all

            If UCase(olItm.Subject) Like "*" & UCase(strFind) & "*" Or _
                    UCase(olItm.Body) Like "*" & UCase(strFind) & "*" Then

to

Code: Select all

            If (UCase(olItm.Subject) Like "*" & UCase(strFind) & "*" Or _
                    UCase(olItm.Body) Like "*" & UCase(strFind) & "*") AND _
                    Year(olItm.ReceivedTime) = 2014 Then

[sal21]

Change

Code: Select all

            If UCase(olItm.Subject) Like "*" & UCase(strFind) & "*" Or _
                    UCase(olItm.Body) Like "*" & UCase(strFind) & "*" Then

to

Code: Select all

            If (UCase(olItm.Subject) Like "*" & UCase(strFind) & "*" Or _
                    UCase(olItm.Body) Like "*" & UCase(strFind) & "*") AND _
                    Year(olItm.ReceivedTime) = 2014 Then

OPs!!!

but if the string Test is found i body can get the part of string?

Example:
Test: 12345678

Im need to get the value 12345678

Note:
The position of of 12345678 is always in the same position in mid 6, 8

[HansV]

Try this version:

Code: Select all

Sub FindMail()
    Dim strFind As String
    Dim strFolder As String
    Dim olApp As Object
    Dim olNsp As Object
    Dim olFld As Object
    Dim olItm As Object
    Dim lngPos As Long
    strFind = "CALM"
    strFolder = "Ed"
    Set olApp = CreateObject(Class:="Outlook.Application")
    Set olNsp = olApp.GetNamespace("MAPI")
    Set olFld = olNsp.GetDefaultFolder(6).Parent.Folders(strFolder) ' 6 = olFoldersInbox
    For Each olItm In olFld.Items
        If TypeName(olItm) = "MailItem" Then
            If UCase(olItm.Subject) Like "*" & UCase(strFind) & "*" And _
                    Year(olItm.ReceivedTime) = 2014 Then
                Debug.Print olItm.SenderName
            End If
            If UCase(olItm.body) Like "*" & UCase(strFind) & "*" And _
                    Year(olItm.ReceivedTime) = 2014 Then
                lngPos = InStr(1, olItm.body, strFind, vbTextCompare)
                Debug.Print olItm.SenderName
                Debug.Print Mid(olItm, lngPos + Len(strFind) + 2, 8)
            End If
        End If
    Next olItm
    Set olFld = Nothing
    Set olNsp = Nothing
    Set olApp = Nothing
End Sub