Private WithEvents olItems As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olItems = olNS.GetDefaultFolder(olFolderInbox).Items
Debug.Print "Application_Startup wird ausgeführt"
End Sub
Private Sub olItems_ItemAdd(ByVal item As Object)
Dim olMail As Outlook.MailItem
Dim olAtt As Outlook.Attachment
Dim Dateipfad As String
If TypeName(item) = "MailItem" Then
Set olMail = item
If InStr(olMail.Subject, "Test") <> 0 And _
olMail.SenderEmailAddress = "gaby.roester@kirchhoff-automotive.com" Then
For Each olAtt In olMail.Attachments
Dateipfad = "C:\Users\ahenke\Desktop\BDE\" & olAtt.FileName
olAtt.SaveAsFile Dateipfad
Next olAtt
End If
End If
End Sub