Suuuper, einfach perfekt - Merci!
Danke für den Tipp - bin noch relativ neu im VBA Business - habe vor 3 Wochen damit angefangen mir Codes zusammen zu suchen, anzupasse, selbst zu schreiben und zu verstehen, aber manchmal fehlt der letzte Kniff.
Falls du mir noch bei einem Thema helfen möchtest, wo ich auch nicht weiter komme - dann gerne :)
Ähnliches Thema:
- Nun will ich den Anhang der E-Mails die in dem angegebenen Zeitraum eingegangen sind auf meinen Drive downloaden.
- Ich glaube hier habe ich einen größeren Denkfehler drin.
- Ich weiß nicht an welcher Stelle die Datums If-Abfrage rein muss - um den Intervall zu aktivieren
- Der Download funktioniert, allerdings werden alle Dokumente die vorhanden sind gedownloaded.
Viele Grüße,
Tobi
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
|