Dateianhang aus Outlook herunterladen
28.08.2018 16:45:28
Janosch
heute benötige ich eure Hilfe.
Ich versuche, via VBA Code aus Excel, mehrere Dateianhänge aus einer E-Mail zu erkennen und diese Anhänge auf einem definierten Ordner zu speichern.
Bisher habe ich es geschafft, dass ich den Posteingang (Inbox) auslesen und die Datei speichern kann. Allerdings schaffe ich es nicht, einen Unterordner zu durchsuchen. Ich suche nun seit ca. 8 Tagen und schaffe es einfach nicht.
Folgenden Code nutze ich:
Const olFolderInbox = 6 ?liegt es hieran?
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.Cursor = xlWait
Dim oOutlook As Object
Dim oOlns As Object
Dim oOlInb As Object
Dim unRead, m As Object, att As Object
Set oOutlook = GetObject(, "Outlook.application")
Set oOlns = oOutlook.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox) ?Unterordner?
Set unRead = oOlInb.Items.Restrict("[UnRead] = True")
File_Path = "C:\Desktop\"
If unRead.Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Else
Do While unRead.Count > 0
For Each m In unRead
If m.Attachments.Count > 0 Then
For Each att In m.Attachments
If att.Filename Like "Dateiname1*" Then
att.SaveAsFile File_Path & att.Filename
End If
Next att
For Each att In m.Attachments
If att.Filename Like "Dateiname2*" Then
att.SaveAsFile File_Path & att.Filename
End If
Next att
For Each att In m.Attachments
If att.Filename Like "Dateiname3*" Then
att.SaveAsFile File_Path & att.Filename
End If
Next att
m.unRead = False
DoEvents
m.Save
End If
Next m
Loop
Application.ScreenUpdating = True
MsgBox "Daten erfolgreich auf dem Laufwerk abgelegt"
Application.Cursor = xlDefault
Exit Sub
End If
End Sub
Ich freue mich sehr, wenn ihr mich unterstützen könnt und bin um jeden Rat dankbar!
Schon jetzt ein dickes Merci! Und schöne Grüße aus Rheinhessen.
Janosch