Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Set Ns = Application.GetNamespace("MAPI")
Set Items = Ns.GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
PrintNewItem Item
End If
End Sub
Private Sub PrintNewItem(Mail As Outlook.MailItem)
Dim strSpeicherpfad As String
Dim strBetreff As String
Dim strSuche As String
strSpeicherpfad = "C:\Users\Public\"
strBetreff = LCase(Mail.Subject)
strSuche = "test"
If InStr(1, strBetreff, strSuche) > 0 Then
Mail.SaveAs (strSpeicherpfad & Mail.Subject & ".msg")
End If
End Sub