Revision: 58599
Updated Code
at July 26, 2012 00:09 by HarleyAR
Updated Code
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
Revision: 58598
Initial Code
Initial URL
Initial Description
Initial Title
Initial Tags
Initial Language
at July 24, 2012 01:06 by HarleyAR
Initial Code
Sub CheckClear_OpManager(MyMail As MailItem) Dim InputFolder As Folder Dim DestFolder As Folder Dim FoundFlag As Boolean If Left(MyMail.Subject, 5) = "Clear" Then FoundFlag = False Set InputFolder = Session.GetDefaultFolder(olFolderInbox) Set DestFolder = InputFolder.Folders.GetLast For Each Mail In InputFolder.Items If Mail.SenderEmailAddress = "[email protected]" And Right(Mail.Subject, Len(MyMail.Subject) - 8) = Right(MyMail.Subject, Len(MyMail.Subject) - 8) And Left(Mail.Subject, 5) <> "Clear" 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
Initial URL
Initial Description
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.
Initial Title
Outook VBA - move cleared Opmanager alerts
Initial Tags
Initial Language
Visual Basic