Outlook Application Startup

Private WithEvents Items As Outlook.Items
Private m_Folder As Outlook.MAPIFolder
Private m_Find As String
Private m_Wildcard As Boolean

Private Const SpeedUp As Boolean = True
Private Const StopAtFirstMatch As Boolean = True


Public Sub Application_Startup()


On Error Resume Next
Dim myFolder As Outlook.MAPIFolder
 Dim myNameSpace As Outlook.NameSpace
 

 
Dim strOutlookFolderPath As String
    Dim oulAusgewaehlte As Outlook.Selection
    Dim intZähler As Integer
    Dim strOutlookMAPIFolders() As String
    Dim mapFld As MAPIFolder
 

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

Set myFolderdes = Application.Session.Folders("Outlook").Folders("\\info@meineadresse.de\Posteingang\gebucht")  
Set Application.ActiveExplorer.CurrentFolder = myFolder
Application.GetNamespace("MAPI").GetDefaultFolder (olFolderInbox)  

Dim msg As Outlook.MailItem
For Each msg In myFolder.Items
If msg.UnRead Then
var = Left(msg.Subject, 15)
If var = "Neue_Reservieru" Then  

 Dim myNameSpace1 As Outlook.NameSpace
 Dim myInbox As Outlook.Folder
 Dim myDestFolder As Outlook.Folder
 Dim myItems As Outlook.Items
 Dim myItem As Object
 

 


msg.SaveAs "C:\mails\" & msg.Subject & ".txt", olTXT  

msg.UnRead = False
 Set myNameSpace1 = Application.GetNamespace("MAPI")  
 Set myInbox = myNameSpace1.GetDefaultFolder(olFolderInbox)
 Set myItems = myInbox.Items
 Set myDestFolder = myInbox.Folders("gebucht")  
 Set myItem = myItems.Find("[SenderEmailAddress] = 'no-reply@meineadress.de'")  
 While TypeName(myItem) <> "Nothing"  
 myItem.Move myDestFolder
 Set myItem = myItems.FindNext
 Wend
Else
End If
End If
Next
End Sub