new folder based on subject

Joined
Jun 23, 2011
Messages
1
Reaction score
0
I am completely new to VBA Programming, done C# and C++ so i have some idea on how it would work but still green. I want to create a macro in MS Outlook 2007 that would redirect e-mails that have a string of numbers in the subject to folders created with that subject string. Don't know if i am clear enough. Say I am getting an e-mail with the subject "case #1234xxx" i would like to create a folder "#123xxx" and move the e-mail to that folder (if the folder exists then only move the e-mail), and only use that if the message contains the phrase. Please help. I have viewed some scripts but i would not know how to put them into one to make it work the way i want :)
 
Sub IncomingCheck()
Dim sCase As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim oBugFolder As Outlook.MAPIFolder
Dim oNewFolder As Outlook.MAPIFolder

Set olNS = Outlook.Application.GetNamespace("MAPI")
Set oBugFolder = olNS.GetDefaultFolder(olFolderInbox).Folders("Bug Tracker")


For Each olMail In oBugFolder.Items
If InStr(1, olMail.Subject, "Bug #", vbTextCompare) > 0 Then
sCase = Mid(olMail.Subject, InStr(1, olMail.Subject, "Bug #"), 9)
If FolderExists(sCase) Then
olMail.Move (oBugFolder.Folders(sCase))
Else
Set oNewFolder = oBugFolder.Folders.Add(sCase)
olMail.Move (oBugFolder.Folders(sCase))
End If
End If
Next olMail


Set olMail = Nothing
Set olNS = Nothing
Set oBugFolder = Nothing

End Sub

Function FolderExists(FolderName As String)
Set OlApp = CreateObject("Outlook.Application")
Set NmSpace = OlApp.GetNamespace("MAPI")
Dim oBugFolder As Outlook.MAPIFolder

Set olNS = Outlook.Application.GetNamespace("MAPI")
Set oBugFolder = olNS.GetDefaultFolder(olFolderInbox).Folders("Bug Tracker")

For i = 1 To oBugFolder.Folders.Count
If oBugFolder.Folders(i) = FolderName Then
FolderExists = True
Exit For
Else
FolderExists = False
End If
Next i
End Function
 
Back
Top