将 Outlook Mailitem 保存到本地文件夹

Question

以下代码可以满足我的所有需求：提取电子邮件、保存附件、提取文件 除了将原始电子邮件保存到文件夹 fDest。我似乎看不到解决方案。

这似乎是有问题的行，因为它不会保存电子邮件： "mi.SaveAs fDest2, olMSG"

Sub SaveAttachments()
    Dim ol As Outlook.Application
    Dim ns As Outlook.Namespace
    Dim fol As Outlook.Folder
    Dim i As Object
    Dim mi As Outlook.MailItem
    Dim at As Outlook.Attachment
    Dim Inbox As MAPIFolder
    Dim strDate As String
    Dim oApp As Object
    Dim fDest As Variant
    Dim j As Variant
    Dim sh As String
    Dim FileDialog As FileDialog
    Dim Tracker As Workbook
    Dim fSheet As Sheets
    Dim LastRow As Long
    Dim strFilePath
    Dim fTracker As Workbook
               
    strDate = InputBox("Enter Date in format dd-Mmm-yyyy", "User Date", Format(Now(), "dd-Mmm-yyyy"))
    strFilePath = "\\namdfs\CARDS\MWD\GROUPS\GCM_NAM\2021\05 May\"
    fTrackerName = "Inquiry.Tracker.SWPA.Violations.May.2021.xlsx" '

    On Error Resume Next
        Set fTracker = Workbooks(fTrackerName)
        'If Err Then Set fTracker = Workbooks.Open(strFilePath & fTrackerName)
    On Error GoTo 0
        'Windows(fTrackerName).Activate
      
    Set ol = New Outlook.Application
    Set ns = ol.GetNamespace("MAPI")
    Set fol = ns.Folders("GCMNamLogs").Folders("Inbox")
        
    fDest = "C:\Users\jb76991\Desktop\Violations_Emails\"
    fUser = UCase(Environ("username")) & ":" & Chr(10) & Now()
        
    For Each i In fol.Items.Restrict("@SQL=urn:schemas:httpmail:subject LIKE '%" & strDate & "%'")
        'Debug.Print fDest & i & ".msg"
        If i.Class = olMail Then
            Set mi = i
            fDest2 = fDest & mi.Subject & ".msg"
            mi.SaveAs fDest2, olMSG
            For Each at In mi.Attachments
                'do something with attachments but i've commented it out
            Next at
        End If
    Next i
    MsgBox ("Completed")
    
End Sub

谁能告诉我如何保存被过滤的原始电子邮件？

Answer 1

您必须确保文件名中没有无效字符。请参阅What characters are forbidden in Windows and Linux directory names? 了解更多信息。因此，我建议在将任何内容传递给 SaveAs 方法之前使用 VBA 中可用的 Replace 方法。

另一点是您需要为每封电子邮件指定唯一的文件名。确保生成的文件名对于文件夹是唯一的。