E-Mails aus Outlook als .msg speichern
10.09.2021 14:09:49
Patric
Ich versuche mittels VBA sämtliche E-Mails aus einem Outlook-Ordner in einen bestimmten Datei-Explorer-Ordner als .msg zu speichern.
Beim Versuch, dies durchlaufen zu lassen, erhalte ich bei ".SaveAs FullPath" folgende Fehlermeldung:
"287 - Anwendungs- oder objektdefinierter Fehler"
Kann mir jemand weiterhelfen und sagen, was ich falsch mache?
Ich lade euch noch eine Excel-Datei dazu hoch.
https://www.herber.de/bbs/user/148001.xlsm
Besten Dank für eure Hilfe und einen schönen Tag.
Patric
Folgender Code verwende ich:
Sub MailSpeichern()
Dim olApp As Object
Dim olName As Object
Dim olFolder As Object
Dim olText As String
Dim olItems As Long
Dim Path As String, FullPath As String
Dim Mail As String, Ordner As String, Pfad As String
On Error GoTo Fehler
Mail = Range("C3") 'E-Mailadresse
Ordner = Range("C4")
Pfad = Range("C6")
Set olApp = CreateObject("Outlook.Application")
Set olName = olApp.GetNamespace("MAPI")
Set olFolder = olName.Session.Folders(Mail).Folders(Ordner)
For olItems = 1 To olFolder.Items.Count
Path = Pfad
With olFolder.Items.Item(olItems)
olText = Replace(.Subject, "´", "_")
olText = Replace(olText, "`", "_")
olText = Replace(olText, "'", "_")
olText = Replace(olText, "{", "(")
olText = Replace(olText, "[", "(")
olText = Replace(olText, "]", ")")
olText = Replace(olText, "}", ")")
olText = Replace(olText, "/", "-")
olText = Replace(olText, "", "-")
olText = Replace(olText, ":", "")
olText = Replace(olText, "*", "_")
olText = Replace(olText, "?", "")
olText = Replace(olText, """", "_")
olText = Replace(olText, "|", "_")
olText = Replace(olText, "", "_")
FullPath = Path & Format(.ReceivedTime, "YYYYDDMM") & "-" & Format(.ReceivedTime, "hhmm") & "_" & _
olText & "_" & .Sender & ".msg"
.SaveAs FullPath
End With
Next olItems
Exit Sub
Fehler:
'For Index = 1 To 500
Debug.Print Err.Number & " - " & Error & Chr(10) & FullPath 'Error$(Index)
'Next Index
End Sub