1
Private WithEvents Items As Outlook.Items
2

3
Private Sub Application_Startup()
4
    Dim Ns As Outlook.NameSpace
5
    Set Ns = Application.GetNamespace("MAPI")
6
    Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
7
End Sub

1
Private Sub Items_ItemAdd(ByVal Item As Object)
2
    On Error Resume Next
3
    If TypeOf Item Is Outlook.MailItem Then
4
        Dim mail As Outlook.MailItem
5
        Set mail = Item
6

7
        Dim signUpLine As String
8
        signUpLine = GetLineWithKeyword(mail.Body, "報名時間")
9

10
        If InStr(LCase(mail.Subject), "testa") > 0 And _
11
           InStr(LCase(mail.Body), "testb") > 0 Then
12

13
            Call ShowToast(Replace(mail.Subject, " ", ""), signUpLine)
14
        End If
15
    End If
16
End Sub

1
Private Sub ShowToast(title As String, message As String)
2
    Dim cmd As String
3
    cmd = "D:\\Snoretoast\\snoretoast.exe -appID ""OutlookNotify"" -t """ & title & """ -m """ & message & """ -d long -p D:\\Snoretoast\\01.jpg "
4
    Shell cmd, vbHide
5
End Sub

1
Private Function GetLineWithKeyword(bodyText As String, keyword As String) As String
2
    Dim lines() As String
3
    Dim i As Long
4
    lines = Split(bodyText, vbCrLf)
5

6
    For i = LBound(lines) To UBound(lines)
7
        If InStr(lines(i), "-----Original Message-----") > 0 Or _
8
           InStr(lines(i), "-----轉寄郵件-----") > 0 Then
9
            Exit For
10
        End If
11

12
        If InStr(lines(i), keyword) > 0 Then
13
            GetLineWithKeyword = Trim(lines(i))
14
            GetLineWithKeyword = Replace(GetLineWithKeyword, " ", "")
15
            GetLineWithKeyword = Replace(GetLineWithKeyword, vbTab, "")
16
            Exit Function
17
        End If
18
    Next i
19

20
    GetLineWithKeyword = "(找不到報名時間)"
21
End Function