/ Published in: Visual Basic
VBA Script attached to an Outlook rule to move both the cleared alert email and the original alert email to a specified folder. Includes a 'GetFolder' function to set the proper folder object based off of the folder path.
Expand |
Embed | Plain Text
Copy this code and paste it in your HTML
Function GetFolder(ByVal FolderPath As String) As Outlook.Folder Dim TestFolder As Outlook.Folder Dim FoldersArray As Variant Dim i As Integer If Left(FolderPath, 2) = "\\" Then FolderPath = Right(FolderPath, Len(FolderPath) - 2) 'Convert folderpath to array FoldersArray = Split(FolderPath, "\") Set TestFolder = Application.Session.Folders.Item(FoldersArray(0)) If Not TestFolder Is Nothing Then For i = 1 To UBound(FoldersArray, 1) Dim SubFolders As Outlook.Folders Set SubFolders = TestFolder.Folders Set TestFolder = SubFolders.Item(FoldersArray(i)) If TestFolder Is Nothing Then Set GetFolder = Nothing Next End If 'Return the TestFolder Set GetFolder = TestFolder Exit Function End Function Sub CheckClear_OpManager(MyMail As MailItem) 'FromEmail: the address the emails are received from Const FromEmail = "[email protected]" 'ClearTxt: the start of the subject line indicating a cleared condition Const ClearTxt = "Clear" 'MoveTo: the full path of the destination folder. This is similar to "\\[email protected]\Inbox\MySubfolder" Const MoveTo = "\\[email protected]\Inbox\þ_Notifications" Dim InputFolder As Folder Dim DestFolder As Folder Dim FoundFlag As Boolean Dim LnClTxt As Integer LenClTxt = Len(ClearTxt) If Left(MyMail.Subject, LenClTxt) = ClearTxt Then FoundFlag = False Set InputFolder = Session.GetDefaultFolder(olFolderInbox) 'Set DestFolder = InputFolder.Folders.GetLast Set DestFolder = GetFolder(MoveTo) For Each Mail In InputFolder.Items If Mail.SenderEmailAddress = FromEmail And Right(Mail.Subject, Len(MyMail.Subject) - LenClTxt) = Right(MyMail.Subject, Len(MyMail.Subject) - LenClTxt) And Left(Mail.Subject, LenClTxt) <> ClearTxt Then Mail.UnRead = False Mail.Move DestFolder MyMail.UnRead = False MyMail.Move DestFolder FoundFlag = True Exit For End If Next If Not FoundFlag Then MyMail.UnRead = False MyMail.Move DestFolder End If End If End Sub