Outlook Anhänge aus Mails automatisch exoprtieren - Nur möglich bei manuellem Anstarten des Scriptes

Private Sub Application_NewMail()
Dim Foldername As String, objIn As MAPIFolder, objNewMail As Object, fso as Object, colDelete as New Collection, mail as MailItem
Set fso = CreateObject("Scripting.FilesystemObject")  

Foldername = "C:\temp"  
If Not fso.FolderExists(Foldername) Then
  MkDir Foldername
End If

Set objIn = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)  
For Each objNewMail In objIn.Items
    With objNewMail
        If .UnRead = True Then
            NumberOfMails = .Attachments.Count
            If NumberOfMails > 0 Then
                For i = 1 To NumberOfMails
                    .Attachments.Item(i).SaveAsFile Foldername & "\" & .Attachments.Item(i).FileName  
                Next i
                colDelete.Add objNewMail
            End If
        End If
    End With
Next objNewMail

For each mail in colDelete
  mail.Delete
Next
EndSub

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    On Error Resume Next
    Dim objItem As MailItem, objProperty As UserProperty, arrEntryIDs As Variant, i As Integer, fso As Object, strFolder As String, _
    att As Attachment, strPath As String
    Set fso = CreateObject("Scripting.FilesystemObject")  
    
    strFolder = "C:\temp"  
    If Not fso.FolderExists(strFolder) Then
        MkDir strFolder
    End If
    
    arrEntryIDs = Split(EntryIDCollection, ",")  

    For i = 0 To UBound(arrEntryIDs)
        Set objItem = Application.Session.GetItemFromID(arrEntryIDs(i))
        If objItem.Class = olMail Then
            If objItem.Attachments.Count > 0 Then
                For Each att In objItem.Attachments
                    strPath = strFolder & "\" & att.FileName  
                    counter = 1
                    While fso.FileExists(strPath)
                        strPath = strFolder & "\" & fso.GetBaseName(att.FileName) & "(" & counter & ")." & fso.GetExtensionName(att.FileName)  
                        counter = counter + 1
                    Wend
                    att.SaveAsFile strPath
                Next
                objItem.Delete
            End If
        End If
    Next
End Sub