Since you have not mentioned what needs to be copied, I have left that section empty in the code below.
Also you don’t need to move the email to the folder first and then run the macro in that folder. You can run the macro on the incoming mail and then move it to the folder at the same time.
This will get you started. I have commented the code so that you will not face any problem understanding it.
First paste the below mentioned code in the outlook module.
Then
- Click on Tools~~>Rules and Alerts
- Click on “New Rule”
- Click on “start from a blank rule”
- Select “Check messages When they arrive”
- Under conditions, click on “with specific words in the subject”
- Click on “specific words” under rules description.
- Type the word that you want to check in the dialog box that pops up and click on “add”.
- Click “Ok” and click next
- Select “move it to specified folder” and also select “run a script” in the same box
- In the box below, specify the specific folder and also the script (the macro that you have in module) to run.
- Click on finish and you are done.
When the new email arrives not only will the email move to the folder that you specify but data from it will be exported to Excel as well.
CODE
Const xlUp As Long = -4162
Sub ExportToExcel(MyMail As MailItem)
Dim strID As String, olNS As Outlook.Namespace
Dim olMail As Outlook.MailItem
Dim strFileName As String
'~~> Excel Variables
Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim lRow As Long
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
'~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
'~~> Show Excel
oXLApp.Visible = True
'~~> Open the relevant file
Set oXLwb = oXLApp.Workbooks.Open("C:\Sample.xls")
'~~> Set the relevant output sheet. Change as applicable
Set oXLws = oXLwb.Sheets("Sheet1")
lRow = oXLws.Range("A" & oXLApp.Rows.Count).End(xlUp).Row + 1
'~~> Write to outlook
With oXLws
'
'~~> Code here to output data from email to Excel File
'~~> For example
'
.Range("A" & lRow).Value = olMail.Subject
.Range("B" & lRow).Value = olMail.SenderName
'
End With
'~~> Close and Clean up Excel
oXLwb.Close (True)
oXLApp.Quit
Set oXLws = Nothing
Set oXLwb = Nothing
Set oXLApp = Nothing
Set olMail = Nothing
Set olNS = Nothing
End Sub
FOLLOWUP
To extract the contents from your email body, you can split it using SPLIT() and then parsing out the relevant information from it. See this example
Dim MyAr() As String
MyAr = Split(olMail.body, vbCrLf)
For i = LBound(MyAr) To UBound(MyAr)
'~~> This will give you the contents of your email
'~~> on separate lines
Debug.Print MyAr(i)
Next i