xbananax
05-07-2013, 10:01 AM
First off, I'm fairly new to working with vb so my apologies if this ends of being a silly or easy question.
I've been tasked with creating a script that detects a 5 digit project number (formatted as T-#####) in the subject of an email that was moved to the sent folder, and then moving a copy of that email to a specific folder structure in a shared mailbox based on that project number (Folder structure/path will be 'Projects\Project Root\##\#####' within outlook)
So far I've managed to put together working code that detect the project number in the subject and splits it out for use to create the proper folder names (still not to the point of creating the folder in my code). However I seem to be having issues with the portion of my script that performs the first folder check to see if the parent directory folder exists. Currently if the folder *does* exist, everything is fine and dandy, but if the folder doesn't exist I receive a "440 - Array out of bounds" error which I find odd since the folder check is a simple if statement.
Am I missing something simple, or perhaps structuring the folder check incorrectly? Below is the code I currently have put together, I'll add an indicating comment right above where I believe the error is taking place:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Set olApp = Outlook.Application
Set Items = GetNS(olApp).GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
MsgBox "Mail item added to sent folder, looking for project number in subject"
Dim EmailSub As String
Dim EmailSubArr As Variant
Dim ProjectNum As String
Dim FullProjectNum As String
Dim ParentFolderName As String
Dim SubFolderName As String
If TypeName(item) = "MailItem" Then
'Checks Email Subject for Project Number & Extracts T-#
If InStr(item.Subject, "T-") > 0 Then
MsgBox "Project number found"
EmailSub = item.Subject
EmailSubArr = Split(EmailSub, Chr(32))
For i = LBound(EmailSubArr) To UBound(EmailSubArr)
If InStr(EmailSubArr(i), "T-") > 0 Then
MsgBox "Project number successfully extracted"
FullProjectNum = EmailSubArr(i)
ProjectNum = Right(FullProjectNum, 5)
ParentFolderName = Left(ProjectNum, 2)
SubFolderName = Left(ProjectNum, 5)
'Add Check to see if project number is an extended format (ie T-38322X1)
Exit For
End If
Next i
MsgBox ("Process Check (1 of 3) - Project Number is T-" & ProjectNum)
MsgBox ("Process Check (2 of 3) - Parent Folder Will Be " & ParentFolderName)
MsgBox ("Process Check (3 of 3) - Sub Folder Will Be " & SubFolderName)
MsgBox ("Will Now Perform Folder Checks")
'Create/Copy To Folder
Dim Msg As Outlook.MailItem
Dim fldrparent As Outlook.MAPIFolder
Dim fldrsub As Outlook.MAPIFolder
Set Msg = item
Set fldrparent = Outlook.Session.Folders("Projects").Folders("Project Root").Folders(ParentFolderName)
Set fldrsub = Outlook.Session.Folders("Projects").Folders("Project Root").Folders(ParentFolderName).Folders(SubFolderName)
'''''''''''''''''''''''''' ** FOLDER CHECK ** '''''''''''''''''''''''''''
If fldrparent Is Nothing Then
MsgBox "Parent folder doesn't exist"
Else
MsgBox "Parent folder already exists"
' Do nothing
End If
Else
MsgBox "Did not detect T-##### project number"
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
Set GetNS = app.GetNamespace("MAPI")
End Function
Any input or direction is greatly appreciated! (MsgBox outputs are simply for troubleshooting each stage, I plan on removing them).
I've been tasked with creating a script that detects a 5 digit project number (formatted as T-#####) in the subject of an email that was moved to the sent folder, and then moving a copy of that email to a specific folder structure in a shared mailbox based on that project number (Folder structure/path will be 'Projects\Project Root\##\#####' within outlook)
So far I've managed to put together working code that detect the project number in the subject and splits it out for use to create the proper folder names (still not to the point of creating the folder in my code). However I seem to be having issues with the portion of my script that performs the first folder check to see if the parent directory folder exists. Currently if the folder *does* exist, everything is fine and dandy, but if the folder doesn't exist I receive a "440 - Array out of bounds" error which I find odd since the folder check is a simple if statement.
Am I missing something simple, or perhaps structuring the folder check incorrectly? Below is the code I currently have put together, I'll add an indicating comment right above where I believe the error is taking place:
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Set olApp = Outlook.Application
Set Items = GetNS(olApp).GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
MsgBox "Mail item added to sent folder, looking for project number in subject"
Dim EmailSub As String
Dim EmailSubArr As Variant
Dim ProjectNum As String
Dim FullProjectNum As String
Dim ParentFolderName As String
Dim SubFolderName As String
If TypeName(item) = "MailItem" Then
'Checks Email Subject for Project Number & Extracts T-#
If InStr(item.Subject, "T-") > 0 Then
MsgBox "Project number found"
EmailSub = item.Subject
EmailSubArr = Split(EmailSub, Chr(32))
For i = LBound(EmailSubArr) To UBound(EmailSubArr)
If InStr(EmailSubArr(i), "T-") > 0 Then
MsgBox "Project number successfully extracted"
FullProjectNum = EmailSubArr(i)
ProjectNum = Right(FullProjectNum, 5)
ParentFolderName = Left(ProjectNum, 2)
SubFolderName = Left(ProjectNum, 5)
'Add Check to see if project number is an extended format (ie T-38322X1)
Exit For
End If
Next i
MsgBox ("Process Check (1 of 3) - Project Number is T-" & ProjectNum)
MsgBox ("Process Check (2 of 3) - Parent Folder Will Be " & ParentFolderName)
MsgBox ("Process Check (3 of 3) - Sub Folder Will Be " & SubFolderName)
MsgBox ("Will Now Perform Folder Checks")
'Create/Copy To Folder
Dim Msg As Outlook.MailItem
Dim fldrparent As Outlook.MAPIFolder
Dim fldrsub As Outlook.MAPIFolder
Set Msg = item
Set fldrparent = Outlook.Session.Folders("Projects").Folders("Project Root").Folders(ParentFolderName)
Set fldrsub = Outlook.Session.Folders("Projects").Folders("Project Root").Folders(ParentFolderName).Folders(SubFolderName)
'''''''''''''''''''''''''' ** FOLDER CHECK ** '''''''''''''''''''''''''''
If fldrparent Is Nothing Then
MsgBox "Parent folder doesn't exist"
Else
MsgBox "Parent folder already exists"
' Do nothing
End If
Else
MsgBox "Did not detect T-##### project number"
End If
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
Set GetNS = app.GetNamespace("MAPI")
End Function
Any input or direction is greatly appreciated! (MsgBox outputs are simply for troubleshooting each stage, I plan on removing them).