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")) And CheckKeywords(Email.subject, Array("ERROR")) Then
            If CheckKeywords(Email.subject, Array("logbatch")) Then
                'Call RunAny("D:\Prapun\Email_Trigger\Sound_Alert\run-task.bat")
                PlayMP3 "D:\Prapun\Email_Trigger\Sound_Alert\error_log_batch.mp3"
                ShowAlert "Alert: " & Email.subject
                'SaveEmailAsOft Email, "D:\Prapun\Email_Trigger\2000"
                'Call RunAny("D:\Prapun\Email_Trigger\Sound_Alert\run-task.bat")
            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\"
                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

' Function to play an MP3 file
Private Sub PlayMP3(ByVal filePath As String)
    Dim objPlayer As Object
    On Error Resume Next
    Set objPlayer = CreateObject("WMPlayer.OCX")
    If Not objPlayer Is Nothing Then
        objPlayer.URL = filePath
        objPlayer.Controls.play
        ' Optional: Wait for the playback to finish
        Do While objPlayer.playState = 3 ' 3 = Playing
            DoEvents
        Loop
        Set objPlayer = Nothing
    Else
        ShowAlert "Error: Windows Media Player not available."
    End If
End Sub

' Function to save attachments from an email
Private Sub SaveAttachments(ByVal Email As Outlook.MailItem)
    Dim attachment As Outlook.attachment
    
    ' 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 & 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


modify function save file attached