I need a macro that will move messages received into a shared mailbox to a subfolder of that mailbox, depending on the sender's email address, basically a normal outlook rule.
I've been looking at some articles on http://www.slipstick.com/ which has got me part way there but there isn't an exact solution for what I want to do and I'm not proficient enough with VBA in Outlook yet to work it out.
So far I've got this code on ThisOutlookSession to watch the mailbox:
Dim i As Long
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
Set olInboxItems = GetFolderPath(">Digital Analytics\Inbox").Items
Set objNS = Nothing
End Sub
And this function in a module to obtain the path of the watched mailbox folder:
' Use the GetFolderPath function to find a folder in non-default mailboxes
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function
This works, I used a case to move the item if it came from a specific email address:
Dim i As Long
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
Set olInboxItems = GetFolderPath(">Digital Analytics\Inbox").Items
Set objNS = Nothing
For Each Item In olInboxItems
End Sub
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim objDestFolder As Outlook.MAPIFolder
Dim destFolder As String
Dim sendersAddress As String
If Item.Class = olMail Then
sendersAddress = Item.SenderEmailAddress
Select Case sendersAddress
Case "no-reply@omniture.com"
destFolder = ">Digital Analytics\Inbox\Reports"
Case "no-reply@edigitalresearch.com"
destFolder = ">Digital Analytics\Inbox\Reports"
End Select
Set objDestFolder = GetFolderPath(destFolder)
Item.Move objDestFolder
End If
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.