Save email to a local folder

问题

How do I save email (msg)?

This code creates a daily folder structure and saves email attachments but not the email itself.

Option Explicit
Public Sub saveAttachtoDisk(itm As Outlook.mailitem)
Dim objAtt As Outlook.Attachment
Dim SaveFolder As String

SaveFolder = "C:\Temp\" & Year(Date) & "\" & Month(Date) & "\" & Day(Date)

' Check for folder and create if needed
If Len(Dir("C:\Temp\" & Year(Date), vbDirectory)) = 0 Then
    MkDir "C:\Temp\" & Year(Date)
End If

If Len(Dir("C:\Temp\" & Year(Date) & "\" & Month(Date), _
                                         vbDirectory)) = 0 Then
    MkDir "C:\Temp\" & Year(Date) & "\" & Month(Date)
End If

If Len(Dir("C:\Temp\" & Year(Date) & "\" & Month(Date) & "\" & Day(Date), _
                                                     vbDirectory)) = 0 Then
    MkDir "C:\Temp\" & Year(Date) & "\" & Month(Date) & "\" & Day(Date)
End If

For Each objAtt In itm.Attachments
    objAtt.SaveAsFile SaveFolder & "\" & Format(Date, "yyyymmdd") & "_" & _
                                                         objAtt.DisplayName
Next

Set objAtt = Nothing
End Sub

回答1:

Try

    Dim FileName As String
        FileName = Format(Date, "yyyymmdd") & "_" & objAtt.DisplayName

    itm.SaveAs SaveFolder & "\" & FileName & ".msg", olMsg

Also Replace invalid characters with empty strings, here I'm using Regex

For Each objAtt In itm.Attachments
    Dim FileName As String
        FileName = Format(Date, "yyyymmdd") & "_" & objAtt.DisplayName

    objAtt.SaveAsFile SaveFolder & "\" & FileName

    Dim RegEx As Object
    Set RegEx = CreateObject("vbscript.regexp")
    With RegEx
        .Pattern = "[^\w\@-]"
        .IgnoreCase = True
        .Global = True
    End With

    FileName = RegEx.Replace(FileName, " ")
    itm.SaveAs SaveFolder & "\" & FileName & ".msg", olMsg
Next

Now test your code with Selection.item(1)

Public Sub Test_Rule()
    Dim olMsg As Outlook.mailitem

    Set olMsg = ActiveExplorer.Selection.Item(1)
    saveAttachtoDisk olMsg

End Sub

回答2:

Call itm.SaveAs(..., olMsg) to save in the MSG format

来源：https://stackoverflow.com/questions/48543937/save-email-to-a-local-folder

标签

regex

vba

outlook

outlook-vba