Private WithEvents olInboxItems As Items
Private WithEvents olSentItems As Items
Private WithEvents olDeletedItems As Items
Dim SavedPath As String
Private Const BUSINESS_FOLDER = "clients"
'   Bugfix #9
Dim objNameSpace As Outlook.NameSpace
Dim objStore As Outlook.Store

'   Some basic variables
Dim strFolderName As String
Dim strHits As String

'   Register our event hooks.
Private Sub Application_Startup()

    Dim NS As Outlook.NameSpace
    ' ALEX: add 08-12-16
    Set oInspectors = Application.Inspectors
    
    Set NS = Application.GetNamespace("MAPI")

    Set olInboxItems = Session.GetDefaultFolder(olFolderInbox).Items
    Set olSentItems = Session.GetDefaultFolder(olFolderSentMail).Items
    'Set olDeletedItems = NS.GetDefaultFolder(olFolderDeletedItems).Items
    
    Set NS = Nothing
End Sub


'   This section manages incoming emails.
Private Sub olInboxItems_ItemAdd(ByVal item As Object)

    '   If the item type is a mailitem (email)
    If TypeOf item Is MailItem Then
        '   Validate the email
        ValidateEmail item
    End If

End Sub

'   This section manages outgoing (sent) emails.
'       Note: This is only triggered when the email is placed in Sent Items.
' Emails in outbox, that have not yet been sent, will not be detected.
Private Sub olSentItems_ItemAdd(ByVal item As Object)

    If TypeOf item Is MailItem Then
        ValidateEmail item
    End If

End Sub

' ALEX: START block comment 08-12-16
'   This section manages deleted items.
'Private Sub olDeletedItems_ItemAdd(ByVal item As Object)

'    If TypeOf item Is MailItem Then
'        validateEmail item
'    End If

'End Sub
' ALEX: END


'   This function manages the criteria processing of our items.
'
Private Function ValidateEmail(ByVal item As Object)

    '   The error handler here will avoid the application hanging / terminating unexpectedly.
    On Error GoTo cannotValidate

    '   Prepare outside variables
    Dim olMailItem As MailItem
    
    '   Store the item (email passed to this function)
    Set olMailItem = item
    
    '   Check criteria
    If UCase(olMailItem.Subject) Like UCase("*CB??????*") = True Or UCase(olMailItem.Body) Like _
       UCase("*CB??????*") = True Then
        
        '   Prepare the rest of our variables, to save on memory footprint.
        Dim objOutlook As Outlook.Application
        '    Dim objNameSpace As Outlook.NameSpace
        Dim objSourceFolder As Outlook.MAPIFolder
        Dim objDestFolder As Outlook.MAPIFolder
        Dim strCriteria As String
        
        '   Store received criteria
        If UCase(olMailItem.Subject) Like UCase("*CB??????*") = True Then
            strCriteria = Mid(olMailItem.Subject, InStr(UCase(olMailItem.Subject), "CB"), 8)
        ElseIf UCase(olMailItem.Body) Like UCase("*CB??????*") = True Then
            strCriteria = Mid(olMailItem.Body, InStr(UCase(olMailItem.Body), "CB"), 8)
        End If
        
        '   Set the value of our scope variables.
        Set objOutlook = Application
        '   Buxfix #9 - Bind NameSpace relative to MailItem.
        Set objNameSpace = olMailItem.Session
        Set objStore = olMailItem.Parent.Store
        
        Set objSourceFolder = objNameSpace.GetDefaultFolder(olFolderInbox)
        '   This is where the initial magic of this macro runs.
        '       Note: This macro searches all folders that begin with the criteria passed.
        Set objDestFolder = GetFolder(getDestinationFolder(strCriteria))
    
        '   Check that the final destination variable is now saved.
        '       WIP - Want to set this as a 'nothing' value, and compare against 'if not objDestFolder isnothing' then.
        '           Obviously; If this criteria is not met, the macro did not find a destination folder, and then will skip it.
        If Not objDestFolder Is Nothing Then
            olMailItem.Move objDestFolder
        End If
        
        '   Clear the variables defined in this scope.
        Set objOutlook = Nothing
        Set objNameSpace = Nothing
        Set objSourceFolder = Nothing
        Set objDestFolder = Nothing
    
    End If

    '   Clear our remaining variable
    Set olMailItem = Nothing

        
cannotValidate:
    ' Take no action - this prevents unhandled exceptions or the macro crashing.

End Function

'   This function searches for the destination folder that meets the criteria of getFolderName (passed) string.
Private Function getDestinationFolder(getFolderName As String)

    '   Error handling
    On Error GoTo failedGetDestinationFolder
    
    
    strFolderName = getFolderName
    
    '   Prepare our variables
    Dim olkStore As Outlook.Store
    Dim olkRoot As Outlook.folder
    Dim olkSearchFolder As Outlook.folder

    '   STR Hits is used to confirm if we have a hit on a folder search for each search - rather
    ' than being saved once for entire app.
    strHits = ""
    
    '   Check if saved path is stored.
    '       Note: That SavedPath is stored the first time any email is processed successfully
    '           (That is, criteria is met, folder is found, and email is stored).
    '           This was created to stop performance impacts when an email was processed in a
    '           mailbox that had hundreds of emails. Instead, now, a relative parent_
    '           path is stored, and subsiquent searches begin from this SavedPath location.
    '       Additionally: We can manage this feature moving forward, allowing it to search that location first, and
    '           then search the whole mailbox if not found.
    '           For the current feature request of DOBG - the 'clients' folder is the only folder we are to search.
    If SavedPath = "" Then
        '   Literally: For each mailbox (account)
        For Each olkStore In objNameSpace.Stores
            If strHits = "" Then
            '   Set this as our current outlook root variable
            Set olkRoot = olkStore.GetRootFolder
            '   For each folder within this root store's
            For Each olkSearchFolder In olkRoot.Folders
                '   Force the application to stop searching again, and again.
                If strHits = "" Then
                    '   If the folder name is CLIENTS
                    If UCase(olkSearchFolder.Name) = "CLIENTS" Then
                        '   Foreach sub folder of the clients folder.
                        For Each olkSearchFSubolder In olkSearchFolder.Folders
                            '   Added here to stop processing folders once the hit is found - given we are using a 'for each'
                            If strHits = "" Then
                                '   Process that folder
                                ProcessFolder olkSearchFolder
                            End If
                        Next
                        
                    End If
                
                End If
            Next
            
            End If
        Next
    '   Else: A saved path DOES exist. Lets begin our searches from that location instead.
    Else
        '   Set our outlook root as the SavedPath variable
        Set olkRoot = GetFolder(SavedPath)
        '   For each folder in that saved path
        For Each olkSearchFolder In olkRoot.Folders
            '   Process the folder.
            ProcessFolder olkSearchFolder
        Next
    End If

    
    '   If there are no hits by this stage, the criteria was met - but the destination folder was not found.
    If strHits = "" Then
        '   Return (string) NULL
        '       Note: I want to change this to setting the result to the vb value nothing.
        getDestinationFolder = "NULL"
    '   Else
    Else
        '   The folder WAS found, return the destination folder.
        getDestinationFolder = strHits
        Exit Function
    End If
    
    '   Unset the variables used in this function.
    Set olkRoot = Nothing
    Set olkStore = Nothing
    Set olkSearchFolder = Nothing
    
failedGetDestinationFolder:
        '   Avoids unexpected application hang / termination.
    Exit Function
End Function
 
 
'   Process the actual folder. This uses an environment (not scope) variable for comparison - avoiding us having to pass this variable each function. Perhaps not ideal?
Sub ProcessFolder(olkFld As Outlook.folder)

    '   Error handling
    On Error GoTo failedProcessingFolder
    
    '   If the folder matches our required criteria (The first 8 characters, in upper case, match the folder name we are looking for (also in upper case))
    'If UCase(olMailItem.Subject) Like UCase("*CB??????*") = True Then
    If UCase(olkFld.Name) Like UCase("*" & strFolderName & "*") = True Then
        '   Set our strHits to a hit.
        strHits = olkFld.FolderPath
        '   Save a relative (In this case, first level - parent) path.
        SavedPath = olkFld.Parent.FolderPath
    '   Else
    Else
        '   Prepare some space for each of the sub folders of this folder.
        Dim olkSub As Outlook.folder
        '   For each sub folder at this level.
        For Each olkSub In olkFld.Folders
            '   Process (sub function) that folder.
            ProcessSubFolder olkSub
        Next
        '   Clear our function variable
        Set olkSub = Nothing
    End If
    
failedProcessingFolder:
    '
    
End Sub

' =====================================
'   ALEX: MAY BE THIS PART IS PROBLEM
' =====================================
'   This function is the same as ProcessFolder, but contains relative code to save a relative path at a subfolder level.
Sub ProcessSubFolder(olkSubFld As Outlook.folder)

    On Error GoTo GetFolder_Error
    
    If UCase(olkSubFld.Name) Like UCase("*" & strFolderName & "*") = True Then
        strHits = olkSubFld.FolderPath
        '   Save the parent parent path (Which will likely be the folder 'clients'.
        SavedPath = olkSubFld.Parent.Parent.FolderPath
    Else
        Dim olkSubSub As Outlook.folder
        For Each olkSubSub In olkSubFld.Folders
            ProcessSubSubFolder olkSubSub
        Next
        
        Set olkSub = Nothing
    End If

GetFolder_Error:
'
End Sub

'   Same again as the above.
Sub ProcessSubSubFolder(olkSubSubFld As Outlook.folder)

    On Error GoTo GetFolder_Error
    
    If UCase(olkSubSubFld.Name) Like UCase("*" & strFolderName & "*") = True Then
        strHits = olkSubSubFld.FolderPath
        '   Save the parent parent parent folder, which again; will likely be the 'clients' folder.
        SavedPath = olkSubSubFld.Parent.Parent.Parent.FolderPath
    End If

    Set olkSubSub = Nothing
GetFolder_Error:
    '
    Exit Sub

End Sub

'   This function is used to return a vb outlook folder object of a string value relative path descriptor.
'       Basically turns '\\example@example.com\Inbox\TestFolder\TestFolder' string value as an Outlook.folder object
Function GetFolder(ByVal FolderPath As String) As Outlook.folder
    '   Prepare our function variables
    Dim TestFolder As Outlook.folder
    Dim FoldersArray As Variant
    Dim i As Integer
    
    ' Error handling
    On Error GoTo GetFolder_Error
    
    '   Parse our string and remove the root definition.
    If Left(FolderPath, 2) = "\\" Then
       FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set TestFolder = Application.Session.Folders.item(FoldersArray(0))
    
    '   Navigate the array to return the actual folder.
    If Not TestFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = TestFolder.Folders
            Set TestFolder = SubFolders.item(FoldersArray(i))
            If TestFolder Is Nothing Then
                Set GetFolder = Nothing
            End If
        Next
    End If
    'Return the TestFolder
    Set GetFolder = TestFolder
    Exit Function
    
GetFolder_Error:
    Set GetFolder = Nothing
    Exit Function
End Function
 
'   N/A
Sub TestGetFolder()
    Dim folder As Outlook.folder
    Set folder = GetFolder("\\Mailbox - Dan Wilson\Inbox\Customers")
    If Not (folder Is Nothing) Then
        folder.Display
    End If
End Sub


' Начало фрагмента A
Private Sub oInspectors_NewInspector(ByVal Inspector As Inspector)
 If Inspector.CurrentItem.Class = olMail Then
  If Len(Inspector.CurrentItem.EntryID) = 0 Then
   Set oMsg = Inspector.CurrentItem
  End If
 End If
End Sub

' Конец фрагмента A
Private Sub oMsg_Send(Cancel As Boolean)
Dim oRecipient As Recipient, oBusinessFolder As MAPIFolder, oEmailCopy As MailItem
 For Each oRecipient In oMsg.Recipients
  ' Начало фрагмента B
  If InStr(1, oRecipient.Address, "gmail.com") Then
' Конец фрагмента B
  oMsg.DeleteAfterSubmit = True
  Set oBusinessFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders(BUSINESS_FOLDER)
  Set oEmailCopy = oMsg.Copy
  oEmailCopy.Move oBusinessFolder
  Exit For
  End If
 Next
End Sub

Private Sub oMsg_Read(Cancel As Boolean)
Dim oRecipient As Recipient, oBusinessFolder As MAPIFolder, oEmailCopy As MailItem
 For Each oRecipient In oMsg.Recipients
  ' Начало фрагмента B
  If InStr(1, oRecipient.Address, "gmail.com") Then
' Конец фрагмента B
  oMsg.DeleteAfterSubmit = True
  Set oBusinessFolder = Application.Session.GetDefaultFolder(olFolderInbox).Parent.Folders(BUSINESS_FOLDER)
  Set oEmailCopy = oMsg.Copy
  oEmailCopy.Move oBusinessFolder
  Exit For
  End If
 Next
End Sub