"Private WithEvents Items As Outlook.Items
Dim OutlookStartTime As Date

Private Sub Application_Startup()
    Dim Inbox As Outlook.Folder
    Set Inbox = Application.Session.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items
    OutlookStartTime = Now
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        Dim Email As Outlook.MailItem
        Set Email = Item
        
        ' Process emails received after Outlook started
        If Email.ReceivedTime >= OutlookStartTime Then
            
            ' Check for specific keywords
            If CheckKeywords(Email.Subject, Array(""logbatch"")) Then
                Call RunAny(""D:\Prapun\Email_Trigger\Sound_Alert\run-task.bat"")
                ShowAlert ""Alert: "" & Email.Subject
                SaveEmailAsOft Email, ""D:\Prapun\Email_Trigger\2000""
            End If

            ' 08.00 TAFF Scan Counter
            If CheckKeywords(Email.Subject, Array(""TAFF Scan Counter :"")) Then
                SaveEmailAsOft Email, ""D:\Prapun\Email_Trigger\0800_TAFF_Scan_Counter\""
                ShowAlert ""Alert: "" & Email.Subject
            End If

            ' 09.00 - GoldV5 Referential Data Checking Report as of
            If CheckKeywords(Email.Subject, Array(""GoldV5 Referential Data Checking Report as of"")) And _
               CheckSenderEmail(Email, ""GOLD_V5@bigc.co.th"") Then
                SaveEmailAsOft Email, ""D:\Prapun\Email_Trigger\0900_GoldV5_Referential\""
                ShowAlert ""Alert: "" & Email.Subject
            End If

            ' 09.00 - CO ERROR STOCK Network:1092 Round:0900 as Date:
            If CheckKeywords(Email.Subject, Array(""CO ERROR STOCK Network:1092 Round:0900 as Date:"")) And _
               CheckSenderEmail(Email, ""GOLD_V5@bigc.co.th"") Then
                SaveEmailAsOft Email, ""D:\Prapun\Email_Trigger\0900_CO_ERROR\""
                ShowAlert ""Alert: "" & Email.Subject
            End If

            ' 11.00 - CO ERROR XDOCK Network:1092 Round:1100 as Date:
            If CheckKeywords(Email.Subject, Array(""CO ERROR XDOCK Network:1092 Round:1100 as Date:"")) And _
               CheckSenderEmail(Email, ""GOLD_V5@bigc.co.th"") Then
                SaveEmailAsOft Email, ""D:\Prapun\Email_Trigger\1100_CO_ERROR_XDOCK\""
                ShowAlert ""Alert: "" & Email.Subject
            End If

            ' 15.00 - CO ERROR XDOCK Network:1092 Round:1500 as Date:
            If CheckKeywords(Email.Subject, Array(""CO ERROR XDOCK Network:1092 Round:1500 as Date:"")) And _
               CheckSenderEmail(Email, ""GOLD_V5@bigc.co.th"") Then
                SaveEmailAsOft Email, ""D:\Prapun\Email_Trigger\1500_CO_ERROR_XDOCK\""
                ShowAlert ""Alert: "" & Email.Subject
            End If
            
            ' 15.00 - CO ERROR STOCK Network:1092 Round:1500 as Date:
            If CheckKeywords(Email.Subject, Array(""CO ERROR STOCK Network:1092 Round:1500 as Date:"")) And _
               CheckSenderEmail(Email, ""GOLD_V5@bigc.co.th"") Then
                SaveEmailAsOft Email, ""D:\Prapun\Email_Trigger\1500_CO_ERROR_STOCK\""
                ShowAlert ""Alert: "" & Email.Subject
            End If

            ' 20.00 - CO ERROR STOCK Network:1091 Round:2000 as Date:
            If CheckKeywords(Email.Subject, Array(""CO ERROR STOCK Network:1091 Round:2000 as Date:"")) And _
               CheckSenderEmail(Email, ""GOLD_V5@bigc.co.th"") Then
                SaveEmailAsOft Email, ""D:\Prapun\Email_Trigger\2000_CO_ERROR_STOCK\""
                ShowAlert ""Alert: "" & Email.Subject
            End If

            ' [ Task_ITSD ][HO]Checking BIGC-DC&ST EDI
            If CheckKeywords(Email.Subject, Array(""[ Task_ITSD ][HO]Checking BIGC-DC&ST EDI as"")) Then
                ShowAlert ""Alert: "" & Email.Subject
            End If

            If CheckKeywords(Email.Subject, Array(""CO ERROR XDOCK Network:1092 Round:1500"")) Then
                ShowAlert ""Alert: Specific CO ERROR detected - "" & Email.Subject
            End If
            
            ' Uncomment this section if you want to check the sender's email
            If CheckSenderEmail(Email, ""xxxx@gmail.com"") Then
                ShowAlert ""Alert: Sender is 'xxxx@email.com' - "" & Email.Subject
            End If
            
        End If
    End If
End Sub

' Function to Check Keywords in Subject
Private Function CheckKeywords(ByVal subject As String, ByVal keywords As Variant) As Boolean
    Dim keyword As Variant
    Dim allKeywordsFound As Boolean
    allKeywordsFound = True

    For Each keyword In keywords
        If InStr(1, subject, keyword, vbTextCompare) = 0 Then
            allKeywordsFound = False
            Exit For
        End If
    Next keyword

    CheckKeywords = allKeywordsFound
End Function

' Function to check sender's email
Function CheckSenderEmail(ByVal Email As Object, ByVal expectedEmail As String) As Boolean
    CheckSenderEmail = (LCase(Email.SenderEmailAddress) = LCase(expectedEmail))
End Function

' Function to run any application or batch file in the background
Private Sub RunAny(ByVal filePath As String)
    Dim shell As Object
    On Error Resume Next
    Set shell = CreateObject(""WScript.Shell"")
    shell.Run filePath, 0, False
    On Error GoTo 0
End Sub

' Function to save email as .oft
Private Sub SaveEmailAsOft(ByVal Email As Outlook.MailItem, ByVal SaveFolderPath As String)
    Dim fileName As String

    ' Check if the directory exists. If not, create it.
    If Dir(SaveFolderPath, vbDirectory) = """" Then
        On Error Resume Next ' Ignore errors (e.g., if the directory can't be created)
        MkDir SaveFolderPath ' Create the directory
        On Error GoTo 0 ' Reset error handling
    End If

    ' Create a filename using the received time and subject
    fileName = SaveFolderPath & Format(Email.ReceivedTime, ""yyyymmdd_hhnn_"") & _
               CleanFileName(Email.Subject) & "".oft""

    ' Error handling for saving the email
    On Error GoTo SaveError
    ' Save the email as a .oft (Outlook Template) file
    Email.SaveAs fileName, olTemplate
    ' Mark the email as read
    Email.UnRead = False
    Exit Sub

SaveError:
    ShowAlert ""Error saving email: "" & Err.Description
End Sub

' Function to clean file names and replace invalid characters
Private Function CleanFileName(ByVal str As String) As String
    Dim InvalidChars As Variant
    Dim i As Long
    InvalidChars = Array("":"", ""\"", ""/"", ""*"", ""?"", """""""", ""<"", "">"", ""|"")

    For i = LBound(InvalidChars) To UBound(InvalidChars)
        str = Replace(str, InvalidChars(i), ""_"")
    Next i

    CleanFileName = str
End Function

' Function to display alerts
Private Sub ShowAlert(ByVal message As String)
    MsgBox message, vbExclamation, ""Alert""
End Sub"

correct it