[英]How to save Outlook emails on the basis of subject and sender name, using VBA?
我需要在桌面文件夾中保存符合以下條件的電子郵件:
如果同時滿足這兩個條件,則將彈出“是/否”消息框。
碼:
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,但未獲得正確的輸出。
整個代碼在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
建議的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.