Question

如何保存电子邮件(msg)？

此代码创建每日文件夹结构并保存电子邮件附件，但不保存电子邮件本身。

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

Answer 1

尝试

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

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

还用空字符串替换无效字符，这里我使用的是正则表达式

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

现在使用Selection.item(1)

测试您的代码

Public Sub Test_Rule()
    Dim olMsg As Outlook.mailitem

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

End Sub

Answer 2

调用itm.SaveAs(..., olMsg)以MSG格式保存

将电子邮件保存到本地文件夹

2 个答案: