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
olUFolder3.Items.Count
With
olUFolder3.Items.Item(olItemsCount)
For
b = olUFolder.Items.Count
To
1
Step
-1
With
VonDatum <= .ReceivedTime
And
.ReceivedTime < BisDatum
Set
msg = olUFolder3.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