Excel List to Outlook Email Search

[gmayor]

Frankly I don't see why you need to create a new message. Why not simply edit the message you have, given that it is system generated? Something like the following should work - note the comments in the code - especially the first one as you'll need to download some code.

Option Explicit

Public Sub sofWorkWithOutlook()
Dim olApp As Object
Dim olNs As Object
Dim olFldr As Object
Dim olMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim strNum As String
Dim xlSheet As Worksheet
Dim LastRow As Long, lngRow As Long


    'Use the code from the link below to start Outlook properly from Excel
    'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
    Set olApp = outlookApp()


    Set olNs = olApp.GetNamespace("MAPI")
    Set olFldr = olNs.GetDefaultFolder(6)


    Set xlSheet = ActiveSheet
    With xlSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For lngRow = 2 To LastRow
            strNum = .Cells(LastRow, 1)
            For Each olMail In olFldr.Items
                If TypeName(olMail) = "MailItem" Then
                    If (InStr(1, olMail.Subject, strNum, vbTextCompare) > 0) Then
                        With olMail
                            Set olInsp = .GetInspector
                            Set wdDoc = olInsp.WordEditor    'access the message body for editing
                            Set oRng = wdDoc.Range 'orng is the message body
                            '.subject 'is the message subject. Edit it as required
                            .display
                            'edit oRng as required
                            .Save
                            .PrintOut
                            Exit For
                        End With
                    End If
                End If
                DoEvents
            Next olMail
            DoEvents
        Next lngRow
    End With


    Set olMail = Nothing
    Set olFldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
End Sub