[英]How to save Outlook emails on the basis of subject and sender name, using VBA?
I need to save, in a desktop folder, emails which match the following conditions: 我需要在桌面文件夹中保存符合以下条件的电子邮件:
If both of these conditions are met, a Yes/No MsgBox should pop up. 如果同时满足这两个条件,则将弹出“是/否”消息框。
Code: 码:
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
Problem: 问题:
The pop up comes up for all the subject line and all the users. 弹出所有主题行和所有用户。
I tried using nested If else but didn't get the correct output. 我尝试使用嵌套的If,但未获得正确的输出。
The whole code is in ThisOutlookSession. 整个代码在ThisOutlookSession中。
Edit 1 , I removed the On Error Resume Next
. 编辑1 ,我删除了On Error Resume Next
。
The edited code is : 修改后的代码为:
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
A suggested If/Else structure with appropriate mailitem. 建议的If / Else结构以及适当的mailitem。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.