Private Sub inboxItems_ItemAdd(ByVal Item As Object) On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
Dim Subject As String
Dim subjectREFW As String
Dim Company As String
Dim Mill As String
Dim Process As String
Dim ReplyorForward As Boolean
Dim MessageType As String
Dim folderobj As Folder
Dim TempItemCopy As Outlook.MailItem
Dim SubFolderObj As Folder
Dim foldername As String
Dim ns As Outlook.NameSpace
Dim bExceptionReport As Boolean
Dim bShiftReport As Boolean
Dim val As Integer
Dim openPos As Integer
Dim closePos As Integer
Dim midBit As String
Dim MessageInfo
Dim Result
On Error GoTo ErrorHandler
If TypeName(Item) = "MailItem" Then
Subject = Item.Subject
If (InStr(1, Subject, "Exceptions Report for", vbTextCompare) > 0) Then
bExceptionReport = True
Else
bExceptionReport = False
End If
If (InStr(1, Subject, "Shift Reports for", vbTextCompare) > 0) Then
bShiftReport = True
Else
bShiftReport = False
End If
If (bExceptionReport) Then
val = InStr(1, Subject, "Exceptions Report for", vbTextCompare)
Mill = Mid(Subject, val + Len("Exceptions Report for"))
Mill = Trim(Left(Mill, InStr(1, Mill, "(", vbTextCompare) - 2))
Company = (Left(Mill, InStr(1, Mill, " ", vbTextCompare) - 1))
Mill = Trim(Right(Mill, Len(Mill) - (InStr(1, Mill, Company, vbTextCompare) + Len(Company))))
Company = Trim(Company)
Mill = Trim(Mill)
If (InStr(1, Left(Subject, 3), "FW:", vbTextCompare) Or (InStr(1, Left(Subject, 3), "RE:", vbTextCompare))) Then
ReplyorForward = True
Subject = Trim(Right(Subject, Len(Subject) - 3))
Else
ReplyorForward = False
End If
Process = Trim(Left(Subject, InStr(1, Subject, "Exceptions Report for", vbTextCompare) - 1))
Set CompanyFolderObj = CreateFolderIfNeeded(Company, inboxFolders)
Set SiteFolderObj = CreateFolderIfNeeded(Mill, CompanyFolderObj)
Set ProcessFolderObj = CreateFolderIfNeeded(Process, SiteFolderObj)
Set ExceptionReportsFolderObj = CreateFolderIfNeeded("Exception Reports", ProcessFolderObj)
Set ShiftReportsFolderObj = CreateFolderIfNeeded("Shift Reports", ProcessFolderObj)
If (ReplyorForward) Then
' Set TempItemCopy = Item.Copy
' TempItemCopy.Move ProcessFolderObj.Folders("Exception Reports")
' Set TempItemCopy = nothing
Else
Item.Move ProcessFolderObj.Folders("Exception Reports")
End If
End If
If (bShiftReport) Then
val = InStr(1, Subject, "Shift Reports for", vbTextCompare)
openPos = InStr(1, Subject, "-", vbTextCompare)
closePos = InStr(openPos + 1, Subject, "-")
Mill = Trim(Mid(Subject, openPos + 1, closePos - openPos - 1))
Company = Trim(Mid(Subject, val + Len("Shift Reports for"), openPos - (val + Len("Shift Reports for"))))
If (InStr(1, Left(Subject, 3), "FW:", vbTextCompare) Or (InStr(1, Left(Subject, 3), "RE:", vbTextCompare))) Then
ReplyorForward = True
Else
ReplyorForward = False
End If
openPos = InStr(1, Subject, "-", vbTextCompare)
closePos = InStr(openPos + 1, Subject, "-")
Process = Trim(Mid(Subject, closePos + 1, InStr(closePos, Subject, "KPIs", vbTextCompare) - closePos - 1))
Set CompanyFolderObj = CreateFolderIfNeeded(Company, inboxFolders)
Set SiteFolderObj = CreateFolderIfNeeded(Mill, CompanyFolderObj)
Set ProcessFolderObj = CreateFolderIfNeeded(Process, SiteFolderObj)
Set ExceptionReportsFolderObj = CreateFolderIfNeeded("Exception Reports", ProcessFolderObj)
Set ShiftReportsFolderObj = CreateFolderIfNeeded("Shift Reports", ProcessFolderObj)
If (ReplyorForward) Then
' Set TempItemCopy = Item.Copy
' TempItemCopy.Move ProcessFolderObj.Folders("Shift Reports")
' Set TempItemCopy = nothing
Else
Item.Move ProcessFolderObj.Folders("Shift Reports")
End If
End If
Set CompanyFolderObj = Nothing
Set SiteFolderObj = Nothing
Set ProcessFolderObj = Nothing
Set ExceptionReportsFolderObj = Nothing
Set ShiftReportsFolderObj = Nothing
End If
ExitNewItem:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description 'enter code here`
Resume ExitNewItem
End Sub