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

Harish Shrivastava

New Member
Outlook version
Outlook 2013 32 bit
Email Account
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

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange

Harish Shrivastava

New Member
Outlook version
Outlook 2013 32 bit
Email Account
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

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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)

Code:
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

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
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.
 
Top