VBA - Email speichern auf Laufwerk
11.01.2019 10:15:47
Arnd-Olav
ich habe einen Code geschrieben, um eine in Outlook markierte eMail auf der Festplatte zu speichern.
Der Name der gespeicherten .msg Datei soll mit einem individuellen Text per Inbox starten, dann kommt das Wort "from" dann der Sendername, Subject und ein Datum/Zeitstempel.
Das Macro funktioniert, aber nicht immer. Ich finde den Fehler nicht, warum es mal durchläuft und mal nicht.
Kann das daran liegen, dass die Mails auf einem Netzwerklaufwerk gespeichert werden sollen, und die Verbindung manchmal zu langsam aufgebaut wird...oder so ähnlich?
Der Code sieht wie folgt aus:
Option Explicit
Public Sub SaveMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
Dim sSenderName As String
Dim optName As String
Dim inputData As String
enviro = CStr(Environ("USERPROFILE"))
inputData = InputBox("Enter the IPO Number", "Input Box Text")
' Check to see if any data was entered
If inputData "" Then
For Each objItem In ActiveExplorer.Selection
If objItem.MessageClass = "IPM.Note" Then
Set oMail = objItem
sName = oMail.Subject
ReplaceCharsForFileName sName, ""
sSenderName = oMail.SenderName
dtDate = oMail.ReceivedTime
sName = inputData & " " & "from " & sSenderName & sName & Format(dtDate, "yymmdd", _
vbUseSystemDayOfWeek, _
vbUseSystem) & ".msg"
sPath = "P:\CUSTOMERSERVICE\Kitting_Factory\Spares-Procurement\02_AOG_TEAM\ASOBB3\macro\mail\"
Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMSG
End If
Next
End If
Set objItem = Nothing
Set oMail = Nothing
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "'", sChr)
sName = Replace(sName, "*", sChr)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "", sChr)
sName = Replace(sName, "|", sChr)
End Sub