Issue with inboxItems_ItemAdd

[ijourneaux]

I am not trying to do anything too sophisticated. I am thinking that this might be related to which device sees the new email first. This code exists on my windows PC and seems to work work. Perhaps the issue occurs if I first see the new message on my phone when my windows PC is offline.

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