Private WithEvents Items As Outlook.Items
Dim OutlookStartTime As Date

' Declaration for ShellExecute API (for playing MP3 and running batch files)
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" (ByVal hwnd As LongPtr, _
    ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long

Const SW_SHOWNORMAL As Long = 1

Private Sub Application_Startup()
    Dim Inbox As Outlook.Folder
    Set Inbox = Application.Session.GetDefaultFolder(olFolderInbox)
    Set Items = Inbox.Items
    OutlookStartTime = DateAdd("s", 15, 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", "OK")) Then
                'Call RunAny("D:\Prapun\Email_Trigger\Sound_Alert\check_file.bat")
                'PlayMP3 "D:\Prapun\Email_Trigger\Sound_Alert\logbatch-ok.mp3"
                'ShowAlert "Alert: " & Email.subject
                'Call RunAny("D:\Prapun\Email_Trigger\Sound_Alert\logbatch-ok.exe")
                'CreateLogFile "D:\Prapun\Email_Trigger\Sound_Alert\logbatch-ok.txt"
                'RunExe "D:\Prapun\Email_Trigger\Sound_Alert\logbatch-ok.exe"
            End If

            If CheckKeywords(Email.subject, Array("Logbatch", "ERROR")) Then
                'CreateLogFile "D:\Prapun\Email_Trigger\Sound_Alert\logbatch-error.txt"
                PlayMP3 "D:\Prapun\Email_Trigger\Sound_Alert\logbatch-error.mp3"
            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\"
                SaveAttachments Email, "D:\Prapun\Email_Trigger\0900_GoldV5_Referential\"
                Call RunAny("D:\Prapun\Email_Trigger\0900_GoldV5_Referential\0900_GoldV5_Referential.bat")
                'ShowAlert "Alert: " & Email.subject
            End If

            ' 09.00 - CO ERROR STOCK Network:1091 Round:0900 as Date:
            If CheckKeywords(Email.subject, Array("CO ERROR STOCK Network:1091 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
                SaveAttachments Email, "D:\Prapun\Email_Trigger\0900_CO_ERROR\"
                'Call RunAny("D:\Prapun\Email_Trigger\0900_CO_ERROR\0900_CO_ERROR_STOCK_Network1091.bat")
            End If

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

            ' Done 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\"
                SaveAttachments Email, "D:\Prapun\Email_Trigger\1500_CO_ERROR_XDOCK\"
                Call RunAny("D:\Prapun\Email_Trigger\1500_CO_ERROR_XDOCK\1500_CO_ERROR_XDOCK.bat")
                'ShowAlert "Alert: " & Email.subject
            End If
            
            ' Done 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\"
                SaveAttachments Email, "D:\Prapun\Email_Trigger\1500_CO_ERROR_STOCK\"
                Call RunAny("D:\Prapun\Email_Trigger\1500_CO_ERROR_STOCK\1500_CO_ERROR_STOCK.bat")
                'ShowAlert "Alert: " & Email.subject
            End If

            ' Done 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\"
                SaveAttachments Email, "D:\Prapun\Email_Trigger\2000_CO_ERROR_STOCK\"
                Call RunAny("D:\Prapun\Email_Trigger\2000_CO_ERROR_STOCK\2000_CO_ERROR_STOCK.bat")
                '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


' Function to save attachments from an email
Private Sub SaveAttachments(ByVal Email As Outlook.MailItem, ByVal AttachmentSavePath As String)
    Dim attachment As Outlook.attachment
    
    ' Create the directory if it doesn't exist
    If Dir(AttachmentSavePath, vbDirectory) = "" Then
        On Error Resume Next
        MkDir AttachmentSavePath
        On Error GoTo 0
    End If
    
    ' Loop through each attachment and save it
    For Each attachment In Email.Attachments
        On Error Resume Next ' In case of any error while saving
        attachment.SaveAsFile AttachmentSavePath & CleanFileName(attachment.fileName)
        If Err.Number <> 0 Then
            ShowAlert "Error saving attachment: " & attachment.fileName & " - " & Err.Description
            Err.Clear
        End If
        On Error GoTo 0 ' Reset error handling
    Next attachment
End Sub

Private Sub CreateLogFile(logPath As String)
    On Error GoTo ErrorHandler ' Enable error handling

    With CreateObject("Scripting.FileSystemObject")
        With .CreateTextFile(logPath, True)
            .WriteLine "Log file created on " & Now
            .Close
        End With
    End With

    Exit Sub

ErrorHandler:
    MsgBox "Error creating log file: " & Err.Description, vbCritical
End Sub

Public Sub PlayMP3(filePath As String)
    Dim vlcPath As String
    Dim command As String

    vlcPath = "C:\Program Files (x86)\VideoLAN\VLC\vlc.exe" ' Update this path as necessary
    If Dir(vlcPath) <> "" Then
        ' Build the command with options to play quietly in the background
        command = """" & vlcPath & """" & " -I null --play-and-exit """ & filePath & """"
        shell command, vbHide ' Run the command without showing a window
    Else
        MsgBox "Error: VLC Media Player not found at: " & vbCrLf & vlcPath, vbCritical
    End If
End Sub

Public Sub RunExe(filePath As String)
    Dim command As String

    ' Check if the executable exists
    If Dir(filePath) <> "" Then
        ' Build the command to run the executable
        command = """" & filePath & """" ' Quotes in case there are spaces in the file path
        'shell command, vbNormalFocus ' Run the command with normal window focus
        shell command, vbHide ' Run the command with normal window focus
    Else
        MsgBox "Error: Executable file not found at: " & vbCrLf & filePath, vbCritical
    End If
End Sub


make it ignore any error, keep it run all through