Posted By

HarleyAR on 07/24/12

Tagged

Versions (?)

Last Edited at 07/24/12 01:06am

Statistics

Viewed 137 times

Favorited by 0 user(s)

Related snippets

Outook VBA - move cleared Opmanager alerts

/ 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.

Highlighted TextExpand

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 = "OPManagerSRV@vitranexpress.com"
    '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 "\\myemail@company.com\Inbox\MySubfolder"
    Const MoveTo = "\\Garry.Harley@vitran.com\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

Report this snippet Tweet

Comments

Subscribe to comments

Comment:

You need to login to post a comment.