Private WithEvents Items As Outlook.Items

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

Private Sub Items_ItemAdd(ByVal Item As Object)
    On Error GoTo ErrorHandler
    If TypeOf Item Is Outlook.MailItem Then
        Dim Email As Outlook.MailItem
        Set Email = Item
        
        ' Check if any condition is met
        If CheckEmailConditions(Email) Then
            ' Alert the user
            MsgBox "New email received from: " & Email.SenderEmailAddress & vbCrLf & _
                   "Subject: " & Email.Subject, vbInformation, "Alert: Email Match Found"
                   
            ' Perform the action (e.g., save the email as a .msg file)
            SaveEmailAsMsg Email
        End If
    End If
    Exit Sub

ErrorHandler:
    ' Handle any errors
    Debug.Print "Error: " & Err.Description
End Sub

Private Function CheckEmailConditions(ByVal Email As Outlook.MailItem) As Boolean
    ' Check each condition separately and return True if any condition is met
    If CheckSubjectError(Email) Or _
       CheckSenderEmail(Email) Or _
       CheckOtherCondition1(Email) Or _
       CheckOtherCondition2(Email) Then
        CheckEmailConditions = True
    Else
        CheckEmailConditions = False
    End If
End Function

Private Function CheckSubjectError(ByVal Email As Outlook.MailItem) As Boolean
    ' Condition a: Check if subject equals "ERROR"
    If Email.Subject = "ERROR" Then
        CheckSubjectError = True
    Else
        CheckSubjectError = False
    End If
End Function

Private Function CheckSenderEmail(ByVal Email As Outlook.MailItem) As Boolean
    ' Condition b: Check if sender equals "xxxx@gmail.com"
    If Email.SenderEmailAddress = "xxxx@gmail.com" Then
        CheckSenderEmail = True
    Else
        CheckSenderEmail = False
    End If
End Function

Private Function CheckOtherCondition1(ByVal Email As Outlook.MailItem) As Boolean
    ' Condition c: Example for a custom check (add your logic)
    ' Example: Check if subject contains "Important"
    If InStr(Email.Subject, "Important") > 0 Then
        CheckOtherCondition1 = True
    Else
        CheckOtherCondition1 = False
    End If
End Function

Private Function CheckOtherCondition2(ByVal Email As Outlook.MailItem) As Boolean
    ' Condition d: Example for another custom check (add your logic)
    ' Example: Check if the email is marked as High Importance
    If Email.Importance = olImportanceHigh Then
        CheckOtherCondition2 = True
    Else
        CheckOtherCondition2 = False
    End If
End Function

Private Sub SaveEmailAsMsg(ByVal Email As Outlook.MailItem)
    Dim SaveFolderPath As String
    Dim fileName As String

    ' Set the folder where you want to save the .msg files
    SaveFolderPath = "C:\path\to\your\Saved Emails\" ' Change to your desired path

    ' Ensure the folder exists
    If Dir(SaveFolderPath, vbDirectory) = "" Then
        MsgBox "The specified folder does not exist: " & SaveFolderPath
        Exit Sub
    End If

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

    ' Save the email as a .msg file
    Email.SaveAs fileName, olMSG
    ' Mark the email as read
    Email.UnRead = False
End Sub

Private Function CleanFileName(str As String) As String
    ' Replace invalid filename characters with underscores
    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

remove function save email