Consulting

Results 1 to 12 of 12

Thread: Excel List to Outlook Email Search

  1. #1
    VBAX Regular
    Joined
    Dec 2019
    Posts
    13
    Location

    Excel List to Outlook Email Search

    Hello All,

    I'm searching for a VBA Code to find a solution to this very unique situation.

    my team members search for emails using excel file having order numbers in column A and it has invoice number in Column B.

    then search for the email using the subject line containing the order number, which are system generated and come from single system generated email.

    once they find the email they edit the email either by replying or forwarding and taking a print out as they need a hard copy with has both invoice number and order number P.S. they don't send the email they only forward or reply to edit the subject / mail body to add the invoice number.

    I need someone to help me with the code i have the below code but i fail to do the edit forwarding and printing & loop this cycle.

    Sample Table & code below.

    2PmA3.png

    PublicSub sofWorkWithOutlook()
    Dim outlookApp
    Dim olNs As Outlook.Namespace
    Dim Fldr As Outlook.MAPIFolder
    Dim olMail AsVariant
    Dim myTasks

    Dim oMail As MailItem
    Dim myItem As Outlook.MailItem

    'Set outlookApp = New Outlook.Application
    Set outlookApp = CreateObject("Outlook.Application")

    Set olNs = outlookApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
    Set myTasks = Fldr.Items
    Set myItem = Outlook.ActiveInspector.CurrentItem

    '
    Set olMail = myTasks.Find("[Subject] = ""1806594500""")
    '
    ForEach olMail In myTasks
    '
    If(InStr(1, olMail.Body,"1806594500", vbTextCompare)>0)Then
    olMail
    .Display
    Dim myinspector As Outlook.Inspector

    oMail
    .Display
    myItem
    .Forward
    olMail
    .PrintOut
    ExitFor
    EndIf
    Next
    EndSub

  2. #2
    VBAX Regular
    Joined
    Dec 2019
    Posts
    13
    Location
    someone please help

  3. #3
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    VBAX Regular
    Joined
    Dec 2019
    Posts
    13
    Location
    Hey GMayor, thank you for the response, i agree editing directly works fine as well.

    I do not wish to save the changes on the original email. so i removed the .save code. what i achieve is to run this search in a sequence for eg. first search happens on sales order number in column A2 and when it finds it the email then it edits the subject and adds the invoice number from b2 at the end and then takes a print out. once done, the code runs to search for a3 and when it finds it the email then it edits the subject and adds the invoice number from b3 at the end . i hope i'm able to explain what i am trying to achieve.

  5. #5
    VBAX Regular
    Joined
    Dec 2019
    Posts
    13
    Location
    Hey Gmayor,

    My purpose gets met when i add the subject line as
     .Subject = olMail.Subject & " - " & "123" 'is the message subject. Edit it as required
    however what i wish to achieve is a loop to search a2 and then paste b2 in the subecjt instead of the 123 i've mentioned now
    and then search for a3 and then paste b3 in the subject line before printing. i've removed the .save code as i do not wish to make any changes to the original message.

    i'm unable to run this in loop, your code only searches for the last row in the column A as seen in the code which is not what i wish to achieve.

    thank you.

  6. #6
    VBAX Regular
    Joined
    Dec 2019
    Posts
    13
    Location
    Hey Gmayor,


    I've made a few changes and i'm able to meet my requirements on finding the email and editing the subject without saving the changes to the subject but direct printing, what i'm left with is getting these searches of SO Number in sequence of A2, A3 and corresponding invoice number getting pasted into the subject as B2 , B3... respectively.
    Option Explicit
    
    
    Public Sub Test_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 strNum1 As String
    Dim xlSheet As Worksheet
    Dim LastRow As Long, lngRow As Long
    Dim Subject As Long
    Dim LastRow1 As Long, lngRow1 As Long
    
    
    
    
        'Set olApp = outlookApp()
        Set olApp = GetObject(, "Outlook.Application")
    
    
    
    
        Set olNs = olApp.GetNamespace("MAPI")
        Set olFldr = olNs.GetDefaultFolder(6)
        
        Set xlSheet = ActiveSheet
        With xlSheet
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            LastRow1 = .Cells(.Rows.Count, "B").End(xlUp).Row
            
        For lngRow = 1 To LastRow
            For lngRow1 = 1 To LastRow1
                strNum = .Cells(LastRow, 1)
                strNum1 = .Cells(LastRow1, 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 = olMail.Subject & " " & strNum1
                                '.Display
                                'edit oRng as required
                                '.Save
                                .PrintOut
                                Exit For
                            End With
                        End If
                    End If
                    DoEvents
                Next olMail
                DoEvents
            Next lngRow1
        Next lngRow
        End With
    
    
    
    
    
    
    
    
        Set olMail = Nothing
        Set olFldr = Nothing
        Set olNs = Nothing
        Set olApp = Nothing
    End Sub
    i'm unable to run this in loop, your code only searches for the last row subject in the column A as seen in the code which is not what i wish to achieve.


    thank you.

    couldn't edit the earlier reply hence adding a new reply

  7. #7
    VBAX Regular
    Joined
    Dec 2019
    Posts
    13
    Location
    Quote Originally Posted by gmayor View Post
    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.

    Hi Gmayor, could you please help me with this.

  8. #8
    There was a typo in my original, which is why it only processed the last row and why your subsequent changes, echoed the same issue. The following should address your comments.

    Public Sub Test_sofWorkWithOutlook()
    Dim olApp As Object
    Dim olNs As Object
    Dim olFldr As Object
    Dim olMail As Object
    Dim strNum As String
    Dim strNum1 As String
    Dim xlSheet As Worksheet
    Dim LastRow As Long, lngRow As Long
    Dim Subject As Long
    
    
        'Set olApp = outlookApp()
        Set olApp = GetObject(, "Outlook.Application")
    
    
        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 = 1 To LastRow
                strNum = .Cells(lngRow, 1)
                strNum1 = .Cells(lngRow, 2)
                For Each olMail In olFldr.Items
                    If TypeName(olMail) = "MailItem" Then
                        If (InStr(1, olMail.Subject, strNum, vbTextCompare) > 0) Then
                            With olMail
                                .Subject = olMail.Subject & " " & strNum1
                                .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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    VBAX Regular
    Joined
    Dec 2019
    Posts
    13
    Location

    Thumbs up

    Quote Originally Posted by gmayor View Post
    There was a typo in my original, which is why it only processed the last row and why your subsequent changes, echoed the same issue. The following should address your comments.
    Oh My GOD! you wouldn't believe how big of a relief this is for me. could you explain where was the typo so that i'm able to learn the VBA further more.

    Thanks a Million ! you Rock Sir.

  10. #10
    strNum = .Cells(LastRow, 1)
    Should be
    strNum = .Cells(lngRow, 1)
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  11. #11
    VBAX Regular
    Joined
    Dec 2019
    Posts
    13
    Location
    Quote Originally Posted by gmayor View Post
    strNum = .Cells(LastRow, 1)
    Should be
    strNum = .Cells(lngRow, 1)

    Hi @gmayor,

    Thank you so much for your support on this code so far. i wish to understand how do i save the searched email item as PDF rather than printing.

    i searched over the web, however didn't find relevant solution or maybe i didn't understand.

    I'm hoping there would be a simpler way to save the mail item as PDF.

    Regards,
    Pawan Tejani.

  12. #12
    VBAX Regular
    Joined
    Dec 2019
    Posts
    13
    Location
    Hey, i was able to resolve the above issue, by adding the below line
    .SaveAs Environ("HOMEPATH") & "\My Documents\" & olMail.Subject & ".html", olHTML
    now another request is to search in all the folders and not only the inbox folders. as few users move emails to sub folders or save to archive or PSTs.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •