如何使用 VBA 根据主题和发件人姓名保存 Outlook 电子邮件？答案

【问题标题】：How to save Outlook emails on the basis of subject and sender name, using VBA?如何使用 VBA 根据主题和发件人姓名保存 Outlook 电子邮件？
【发布时间】：2019-04-29 12:42:49
【问题描述】：

我需要在桌面文件夹中保存符合以下条件的电子邮件：

主题以 RE: FOR REVIEW 开头
发件人名称为：Alpha、Beta 或 Gamma（示例）

如果满足这两个条件，应该会弹出 Yes/No MsgBox。

代码：

Private WithEvents InboxItems As Outlook.Items
Sub Application_Startup()
Dim xNameSpace As Outlook.NameSpace
Set xNameSpace = Outlook.Application.Session
Set InboxItems = xNameSpace.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub InboxItems_ItemAdd(ByVal objItem As Object)
 Dim FSO
 Dim xMailItem As Outlook.MailItem
 Dim xFilePath As String
 Dim xRegEx
 Dim xFileName As String
 Dim Output As String
 Dim Item As Object
 On Error Resume Next

  If (Item.Subject Like "RE:FOR REVIEW*") And ((Item.SenderName = "Alpha") Or (Item.SenderName = "Beta") or (Item.SenderName = "Gamma") ) Then
   Output = MsgBox("Do you want to save this email?", vbYesNo + vbQuestion, "Reminder")
   If Output = vbNo Then Exit Sub
    Else
     xFilePath = CreateObject("WScript.Shell").SpecialFolders(16)
     xFilePath = "C:\Users\ABC\Desktop\Test"
     Set FSO = CreateObject("Scripting.FileSystemObject")
     If FSO.FolderExists(xFilePath) = False Then
      FSO.CreateFolder (xFilePath)
     End If
     Set xRegEx = CreateObject("vbscript.regexp")
    xRegEx.Global = True
    xRegEx.IgnoreCase = False
    xRegEx.Pattern = "\||\/|\<|\>|""|:|\*|\\|\?"
    If objItem.Class = olMail Then
     Set xMailItem = objItem
    xFileName = xRegEx.Replace(xMailItem.Subject, "")
    xMailItem.SaveAs xFilePath & "\" & xFileName & ".html", olHTML
    End If
   End If

Exit Sub
End Sub

问题：
所有主题行和所有用户都会弹出窗口。

我尝试使用嵌套 If else 但没有得到正确的输出。

整个代码都在 ThisOutlookSession 中。

编辑 1，我删除了 On Error Resume Next 。

编辑后的代码是：

Private WithEvents InboxItems As Outlook.Items
Sub Application_Startup()
Dim xNameSpace As Outlook.NameSpace
Set xNameSpace = Outlook.Application.Session
Set InboxItems = xNameSpace.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub InboxItems_ItemAdd(ByVal objItem As Object)
 Dim FSO
 Dim xMailItem As Outlook.MailItem
 Dim xFilePath As String
 Dim xRegEx
 Dim xFileName As String
 Dim Output As String

  If objItem.Class = olMail Then '**
  Set xMailItem = Application.CreateItem(olMailItem) '**

  If (xMailItem.Subject Like "RE:FOR REVIEW*") And ((xMailItem.SenderName = "Alpha") Or (xMailItem.SenderName = "Beta") or (xMailItem.SenderName = "Gamma") ) Then
     Output = MsgBox("Do you want to save this email?", vbYesNo + vbQuestion, "Reminder")
    If Output = vbNo Then Exit Sub
     Else
      xFilePath = CreateObject("WScript.Shell").SpecialFolders(16)
      xFilePath = "C:\Users\abc\Desktop\Test"
      Set FSO = CreateObject("Scripting.FileSystemObject")
      If FSO.FolderExists(xFilePath) = False Then
       FSO.CreateFolder (xFilePath)
      End If
      Set xRegEx = CreateObject("vbscript.regexp")
     xRegEx.Global = True
     xRegEx.IgnoreCase = False
     xRegEx.Pattern = "\||\/|\<|\>|""|:|\*|\\|\?"
     If objItem.Class = olMail Then
      Set xMailItem = objItem
     xFileName = xRegEx.Replace(xMailItem.Subject, "")
     xMailItem.SaveAs xFilePath & "\" & xFileName & ".html", olHTML
     End If
    End If
  End If
Exit Sub
End Sub

【问题讨论】：

我建议您删除On Error Resume Next 声明。它完全掩盖了该部分代码中发生的所有错误。删除后，再次尝试运行代码 - 看看是否出现实际错误消息。
另外，如果在 if 条件期间发生错误，On Error Resume Next 会直接进入 if 语句的“true”部分。
stackoverflow.com/a/31753321/1571407
谢谢大家的建议。
请看编辑。代码没有显示错误，但我没有得到想要的结果。

标签： excel vba email outlook

【解决方案1】：

带有适当邮件项的建议 If/Else 结构。

Option Explicit

Private Sub InboxItems_ItemAdd(ByVal objItem As Object)

    Dim FSO
    Dim xMailItem As MailItem
    Dim xFilePath As String
    Dim xRegEx
    Dim xFileName As String

    If objItem.Class = olMail Then

        'objItem could be used directly but this is sometimes beneficial
        Set xMailItem = objItem

        If (xMailItem.subject Like "RE:FOR REVIEW*") Then

            If ((xMailItem.senderName = "Alpha") Or _
                (xMailItem.senderName = "Beta") Or _
                (xMailItem.senderName = "Gamma")) Then

                If MsgBox("Do you want to save this email?", vbYesNo + vbQuestion, "Reminder") = vbYes Then

                    xFilePath = "C:\Users\abc\Desktop\Test"

                    Set FSO = CreateObject("Scripting.FileSystemObject")
                    If FSO.FolderExists(xFilePath) = False Then
                        FSO.CreateFolder (xFilePath)
                    End If

                    Set xRegEx = CreateObject("vbscript.regexp")
                    xRegEx.Global = True
                    xRegEx.IgnoreCase = False
                    xRegEx.Pattern = "\||\/|\<|\>|""|:|\*|\\|\?"

                    xFileName = xRegEx.Replace(xMailItem.subject, "")

                    xMailItem.SaveAs xFilePath & "\" & xFileName & ".html", olHTML

                End If

            End If

        End If

    End If

End Sub

【讨论】：