Enailsummary

Sub GenerateOrderUpdateSummaryHourly()

    ' Outlook objects

    Dim olApp As Outlook.Application

    Dim olNS As Outlook.NameSpace

    Dim sentFolder As Outlook.folder

    Dim responseFolder As Outlook.folder

    Dim sentItems As Outlook.Items

    Dim responseItems As Outlook.Items

    Dim sentEmail As Outlook.mailItem

    Dim responseEmail As Outlook.mailItem



    ' Variables

    Dim folderPairs As Variant

    Dim sentFolderName As String

    Dim responseFolderName As String

    Dim orderNumbers As Collection

    Dim summary As String

    Dim orderStatus As String

    Dim orderNumber As Variant

    Dim carrierEmail As String

    Dim carrierResponseBody As String



    ' Initialize Outlook objects

    Set olApp = Application

    Set olNS = olApp.GetNamespace("MAPI")



    ' **REPLACE WITH YOUR FOLDER PAIRS**

    folderPairs = Array( _

        Array("Sent Items", "PSF"), _

        Array("Sent Items", "BNCC"), _

        Array("Sent Items", "ADDT"), _

        Array("Sent Items", "PDDT") _

    )



    ' Initialize summary

    summary = "Order Update Summary" & vbCrLf & vbCrLf

    summary = summary & "Order Number" & vbTab & "Carrier Email" & vbTab & "Status" & vbCrLf



    ' Loop through each folder pair

    Dim pair As Variant

    For Each pair In folderPairs

        sentFolderName = pair(0)

        responseFolderName = pair(1)



        ' Access the Sent Items folder

        Set sentFolder = olNS.GetDefaultFolder(olFolderSentMail) ' Direct access to Sent Items



        ' Access response folder using recursive function

        Set responseFolder = GetFolderByName(olNS.GetDefaultFolder(olFolderInbox), responseFolderName)



        ' Check if response folder has any items

        If Not responseFolder Is Nothing And responseFolder.Items.Count > 0 Then

            Debug.Print "Response Folder Name: " & responseFolderName

            Set sentItems = sentFolder.Items

            Set responseItems = responseFolder.Items



            ' Loop through sent emails

            For Each sentEmail In sentItems

                If sentEmail.Class = olMail Then

                    ' Extract order numbers from the sent email

                    Set orderNumbers = ExtractOrderNumbers(sentEmail.Body)



                    ' Loop through carrier responses

                    For Each responseEmail In responseItems

                        If responseEmail.Class = olMail Then

                            carrierResponseBody = responseEmail.Body

                            carrierEmail = responseEmail.SenderEmailAddress



                            ' Match each order number in the response

                            For Each orderNumber In orderNumbers

                                ' Call the function to get the status based on the response

                                orderStatus = GetCarrierResponse(CStr(orderNumber), carrierResponseBody)



                                ' Add to the summary

                                summary = summary & CStr(orderNumber) & vbTab & carrierEmail & vbTab & orderStatus & vbCrLf

                            Next orderNumber

                        End If

                    Next responseEmail

                End If

            Next sentEmail

        Else

            summary = summary & "Response folder '" & responseFolderName & "' not found or empty" & vbCrLf

        End If

    Next pair



    ' Send the summary email

    Call SendSummaryReport(summary)

End Sub



' Function to get a folder by its name within a parent folder

Function GetFolderByName(parentFolder As Outlook.folder, folderName As String) As Outlook.folder

    Dim subFolder As Outlook.folder

    Dim trackingFolder As Outlook.folder

    On Error Resume Next ' In case folder is not found



    ' First, find the "Tracking" subfolder under Inbox

    Set trackingFolder = parentFolder.Folders("Tracking")



    If Not trackingFolder Is Nothing Then

        ' Now, find the specific carrier subfolder under "Tracking"

        Set subFolder = trackingFolder.Folders(folderName)

    End If



    If Not subFolder Is Nothing Then

        Set GetFolderByName = subFolder

    Else

        Set GetFolderByName = Nothing

    End If



    On Error GoTo 0 ' Reset error handling

End Function



' Function to extract order numbers from email body

Function ExtractOrderNumbers(emailBody As String) As Collection

    Dim orderNumbers As New Collection

    Dim orderNumber As String

    Dim regex As Object

    Set regex = CreateObject("VBScript.RegExp")



    ' Regular expression pattern to match order numbers (example: 1234567890)

    regex.IgnoreCase = True

    regex.Global = True

    regex.Pattern = "\d{10}" ' Match any 10-digit number



    ' Find matches in the email body

    If regex.Test(emailBody) Then

        Dim matches As Object

        Set matches = regex.Execute(emailBody)



        For Each match In matches

            orderNumbers.Add match.Value

        Next match

    End If



    Set ExtractOrderNumbers = orderNumbers

End Function



' Function to determine the carrier's response status based on the email body

Function GetCarrierResponse(orderNumber As String, responseBody As String) As String

    Dim status As String



    ' Check for different responses in the carrier email body

    If InStr(1, responseBody, "delivered", vbTextCompare) > 0 Then

        status = "Delivered"

    ElseIf InStr(1, responseBody, "broke down", vbTextCompare) > 0 Then

        status = "Broke Down"

    ElseIf InStr(1, responseBody, "late", vbTextCompare) > 0 Then

        status = "Late"

    ElseIf InStr(1, responseBody, "on time", vbTextCompare) > 0 Then

        status = "On Time"

    Else

        status = "Unknown"

    End If



    ' Return the status

    GetCarrierResponse = status

End Function



' Function to send the summary report email

Sub SendSummaryReport(summary As String)

    Dim olApp As Outlook.Application

    Dim olMail As Outlook.mailItem



    Set olApp = Application

    Set olMail = olApp.CreateItem(olMailItem)



    ' Set email properties

    olMail.Subject = "Order Update Summary"

    olMail.To = [email protected] ' Replace with your email

    olMail.Body = summary



    ' Send the email

    olMail.Send

End Sub