Macro to Copy Specific content from Mail Body and Paste to Excel

[Harish Shrivastava]

Hi,

Please help me out with an Outlook macro which copies and pastes specific (mentioned below) text from mail body and paste it to excel sheet one after another.

Test to copy looks like:
File Date: 8/19/2016 4:25:20 AM
File Size: 159457 bytes
Records: 8586

This should be pasted horizontally. Only the data after the colon.

What i want is whenever an email comes to a specific folder the macro should run and it should copy the data to excel automatically.

It would be a great help guys. Thanks in advance

 

[Diane Poremsky]

the macro at Use a macro to copy data in Outlook email to Excel workbook shows how to use regex to get values from the message. The example uses one value though - one of the macros at Use RegEx to extract text from an Outlook email message should how to use case statements to get more than one value.

 

[Harish Shrivastava]

Thank you Diane for the reply. It would be really helpful if you help me out with below 2 additions in your code as given in the article:

1. The macro should get the text from an email every time it comes to a particular inbox folder
2. It should paste the text in an Excel sheet one after one.

Thank you for your help.

 

[Diane Poremsky]

Replace the code in Use a macro to copy data in Outlook email to Excel workbook between the With Reg1 and the End If block right before xlSheet.Range("B" & rCount) = vText with the following.


Change the macro name to
Private Sub objItems.ItemAdd(ByVal Item As Object)

Then get the first macro at How to use an ItemAdd Macro and set the folder you want to watch. Working with VBA and non-default Outlook Folders has info on how to refer to different folders.

(the macros all go into ThisOutlookSession)

For i = 1 To 3

With Reg1
    Select Case i
    Case 1
        .Pattern = "File Date:\s((.*))\n"
        .Global = False
       
    Case 2
       .Pattern = "File Size:\s(([\d]*))\n"
       .Global = False
      
    Case 3
        .Pattern = "Records:\s(([\d]*))\n"
        .Global = False
    End Select
   
End With
   
   
    If Reg1.test(olMail.Body) Then
    
        Set M1 = Reg1.Execute(olMail.Body)
        For Each M In M1
            Debug.Print M.SubMatches(1)
            strSubject = M.SubMatches(1)
           
         if i = 1 then vText = strSubject
         if i = 2 then vText2 = strSubject
         if i = 3 then vText3 = strSubject
        
         Next
    End If
         
Next i

 

[Diane Poremsky]

I *think* those patterns will work - you might need to tweak them a bit though. And, of course, you'll need to refer to the correct workbook and sheet.