Option Explicit
 
 
Public Sub PDFDOWN()
 
Dim olapp        As Object
Dim olName       As Object
Dim olHFolder    As Object
Dim olUFolder    As Object
Dim olUFolder2    As Object
 
 
Dim sSavePath    As String
Dim sSaveFolder  As String
Dim msg          As Object
Dim VonDatum As Date, BisDatum As Date
Dim olItemsCount As Long
 
Dim TimeStamp    As String
 
sSaveFolder = "C:\Users\Desktop\DOWNLOAD Outlook\"
 
Set olapp = CreateObject("Outlook.Application")
Set olName = olapp.GetNamespace("MAPI")
Set olHFolder = olName.Session.Folders("Funktionspostfach")
Set olUFolder = olHFolder.Folders("Posteingang")
Set olUFolder2 = olHFolder.Folders("1.01 in Bearbeitung")
 
 
VonDatum = CDate(InputBox("Bitte Datum des ersten zu betrachtenden Tages eingeben:", "Datumseingabe", Format(Now - 1, "DD.MM.YYYY")))
BisDatum = CDate(InputBox("Bitte Datum des letzten zu betrachtenden Tages eingeben:", "Datumseingabe", Format(Now, "DD.MM.YYYY")))
  
VonDatum = DateSerial(Year(VonDatum), Month(VonDatum), Day(VonDatum))
BisDatum = DateSerial(Year(BisDatum), Month(BisDatum), Day(BisDatum) + 1)
 
 
For olItemsCount = 1 To olUFolder.Items.Count
          With olUFolder.Items.Item(olItemsCount)
              
For a = olUFolder.Items.Count To 1 Step -1
With VonDatum <= .ReceivedTime And .ReceivedTime < BisDatum
Set msg = olUFolder.Items(a)
              
             If msg.Attachments.Count > 0 Then
              
                     For aa = msg.Attachments.Count To 1 Step -1
              
            Randomize Timer
strWurf = Int((99999999999# * Rnd) + 1)
 
                sSavePath = (sSaveFolder & msg.Attachments(aa).Filename & "[" & strWurf & "].pdf")
                msg.Attachments(aa).SaveAsFile sSavePath
             
            Next
            End If
      
       End With
         Next
       End With
         
    Next olItemsCount
     
For olItemsCount = 1 To olUFolder2.Items.Count
          With olUFolder2.Items.Item(olItemsCount)
              
For b = olUFolder.Items.Count To 1 Step -1
With VonDatum <= .ReceivedTime And .ReceivedTime < BisDatum
        Set msg = olUFolder2.Items(b)
             If msg.Attachments.Count > 0 Then
              
                         For bb = msg.Attachments.Count To 1 Step -1
             
            Randomize Timer
strWurf = Int((99999999999# * Rnd) + 1)
 
                sSavePath = (sSaveFolder & msg.Attachments(bb).Filename & "[" & strWurf & "].pdf")
                msg.Attachments(bb).SaveAsFile sSavePath
            Next
             
            End If
           
End With
Next
       End With
Next
 
End Sub