Anhänge aller RSS-Feeds-Elemente von einem Outlook-Ordner in ein Verzeichnis auf dem Datenträger abspeichern.

Private Sub Application_NewMail() 

    Dim Foldername As String 
    Dim objIn As MAPIFolder 
    Dim objNewMail As MailItem 
    Dim find As AcFindMatch 
    
    
  
    On Error Resume Next 
    Set objIn = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)   
    For Each objNewMail In objIn.Items 
        With objNewMail 
        ' enter email adress to which the scanner sends the mail between the ""   
        If objNewMail.SenderEmailAddress = "test@adresse.de" Then   
              
            If .UnRead = True Then 
                NumberOfMails = .Attachments.Count 
                
                If NumberOfMails > 0 Then 
                
                            ' create the folder c:\temp and in this folder a folder with the name of the mail subject   
                            ' Existing folders won't be over overwritten, objNewMail.Subject is not case sensitive   
                    Foldername = "C:\temp\" & Replace(objNewMail.Subject, ":", "")   
                    MkDir Foldername 
    
                    For i = 1 To NumberOfMails 
                    
                           ' save the attachment to the folder mentioned   
                           ' above and replace the filname with the mail-body   
                           ' the vbCrLf, "" function replaces vertical spacing   
                           ' pdf is the filetype of the scanned paper   

                           objNewMail.BodyFormat = olFormatPlain 
                            s = Len(.Body) 
                            
                            
                             .Attachments.Item(i).SaveAsFile Foldername & "\" & Replace(Mid(.Body, InStr(.Body, ".com") + 4, s), vbCrLf, "") & ".pdf"   
                        
                            
                          
                    ' Optional: the mail can be deleted after saving   
                    '.Delete   
                    ' Optional: MsgBox for the user   
                    'MsgBox ("Attachment saved successfully")   
                        
                    Next i 
                End If 
            End If 
         End If 
          
        End With 
            
            Next objNewMail 
            End Sub