Mail Anhang automatisch in Ordner verschieben

Sub Application_Startup()
'On Error Resume Next  
Dim myFolder As Outlook.MAPIFolder
Dim myNameSpace As Outlook.NameSpace
Dim OLApp As New Outlook.Application
Dim msg As Outlook.MailItem

 
 
 
 Set myNameSpace = Application.GetNamespace("MAPI")  
 
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("Booking")  

Set Application.ActiveExplorer.CurrentFolder = myFolder
Application.GetNamespace("MAPI").GetDefaultFolder (olFolderInbox)  


For Each msg In myFolder.Items
If msg.UnRead Then
var = Left(msg.Subject, 10)
If var = "Umbuchung " Then  
'If var = "Neue_Reser" Then  
msg.SaveAs "C:\mails\umbuchung" & ".txt", olTXT  
msg.UnRead = False
Else
msg.SaveAs "C:\mails\" & msg.Subject & ".txt", olTXT  
msg.UnRead = False
End If
End If
Next
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set Application.ActiveExplorer.CurrentFolder = myFolder
MoveItems
End Sub