Add folders to single instance of ItemAdd code

2019-08-23 10:19发布

I have ItemAdd code that I would like to apply to every folder in my Outlook inbox.

For example, if I have a rule to move email to an Outlook "Other" folder, I would like it saved to a Windows "\MyEmails" folder.

I prefer not to individually add each folder. Can VBA code add all of the folders?

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

On Error Resume Next

xFilePath = CreateObject("WScript.Shell").SpecialFolders(16)
xFilePath = xFilePath & "\MyEmails"

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 & ".msg", olMsg
End If

Exit Sub

End Sub

0条回答
登录 后发表回答