Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()

Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items

End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

Dim Msg As Outlook.MailItem

If TypeName(item) = "MailItem" Then
   Set Msg = item
End If

MailItem.SaveAs ("FilePathHere", olHTML)

End Sub