Posted By

HarleyAR on 07/24/12


Tagged


Versions (?)

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.

  1. Function GetFolder(ByVal FolderPath As String) As Outlook.Folder
  2. Dim TestFolder As Outlook.Folder
  3. Dim FoldersArray As Variant
  4. Dim i As Integer
  5.  
  6. If Left(FolderPath, 2) = "\\" Then FolderPath = Right(FolderPath, Len(FolderPath) - 2)
  7. 'Convert folderpath to array
  8. FoldersArray = Split(FolderPath, "\")
  9. Set TestFolder = Application.Session.Folders.Item(FoldersArray(0))
  10. If Not TestFolder Is Nothing Then
  11. For i = 1 To UBound(FoldersArray, 1)
  12. Dim SubFolders As Outlook.Folders
  13. Set SubFolders = TestFolder.Folders
  14. Set TestFolder = SubFolders.Item(FoldersArray(i))
  15. If TestFolder Is Nothing Then Set GetFolder = Nothing
  16. Next
  17. End If
  18. 'Return the TestFolder
  19. Set GetFolder = TestFolder
  20. Exit Function
  21.  
  22. End Function
  23.  
  24. Sub CheckClear_OpManager(MyMail As MailItem)
  25.  
  26. 'FromEmail: the address the emails are received from
  27. Const FromEmail = "[email protected]"
  28. 'ClearTxt: the start of the subject line indicating a cleared condition
  29. Const ClearTxt = "Clear"
  30. 'MoveTo: the full path of the destination folder. This is similar to "\\[email protected]\Inbox\MySubfolder"
  31. Const MoveTo = "\\[email protected]\Inbox\รพ_Notifications"
  32.  
  33. Dim InputFolder As Folder
  34. Dim DestFolder As Folder
  35. Dim FoundFlag As Boolean
  36. Dim LnClTxt As Integer
  37.  
  38. LenClTxt = Len(ClearTxt)
  39.  
  40. If Left(MyMail.Subject, LenClTxt) = ClearTxt Then
  41. FoundFlag = False
  42. Set InputFolder = Session.GetDefaultFolder(olFolderInbox)
  43. 'Set DestFolder = InputFolder.Folders.GetLast
  44. Set DestFolder = GetFolder(MoveTo)
  45. For Each Mail In InputFolder.Items
  46. 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
  47. Mail.UnRead = False
  48. Mail.Move DestFolder
  49. MyMail.UnRead = False
  50. MyMail.Move DestFolder
  51. FoundFlag = True
  52. Exit For
  53. End If
  54. Next
  55. If Not FoundFlag Then
  56. MyMail.UnRead = False
  57. MyMail.Move DestFolder
  58. End If
  59. End If
  60. End Sub

Report this snippet  

You need to login to post a comment.