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
Dim strBody As String
Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim M As Match

Set Reg1 = New RegExp
With Reg1
    .Pattern = "/http://www.changedetection.com/log(.*)/ig"
    .Global = False
End With


If Reg1.test(olMail.Body) Then

    Set M1 = Reg1.Execute(olMail.Body)
    For Each M In M1
    strBody = M.SubMatches(1)
    Next
End If

'~~> 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("M:MonitorMonitor_Test_1.xlsx")

'~~> Set the relevant output sheet. Change as applicable
Set oXLws = oXLwb.Sheets("Test")

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
    .Range("C" & lRow).Value = strBody

    '
End With

'~~> Close and Clean up Excel
oXLwb.Close (True)
oXLApp.Quit

Set Reg1 = Nothing
Set oXLws = Nothing
Set oXLwb = Nothing
Set oXLApp = Nothing

Set olMail = Nothing
Set olNS = Nothing