Does this work for you?
Private WithEvents Items As Outlook.ItemsPrivate Sub Application_Startup() Dim olNs As Outlook.NameSpace Dim Inbox As Outlook.MAPIFolder Set olNs = Application.GetNamespace("MAPI") Set Inbox = olNs.GetDefaultFolder(olFolderInbox) Dim Filter As String Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:fromemail" & _ Chr(34) & " Like '%Da.Te@union.de%' And " & _ Chr(34) & "urn:schemas:httpmail:hasattachment" & _ Chr(34) & "=1" Set Items = Inbox.Items.Restrict(Filter) End Sub Private Sub Items_ItemAdd(ByVal Item As Object) If TypeOf Item Is Outlook.MailItem Then Dim FilePath As String FilePath = "C:\Temp\" <--- change to suit Dim AtmtName As String Dim Atmt As attachment For Each Atmt In Item.Attachments AtmtName = FilePath & Atmt.filename Atmt.SaveAsFile AtmtName Next End If EndSub