hMailServer电子邮件管道中的“oMessage”是什么对象？

Question

I'm adapting some hMailServer code I found to MS Outlook vba. The source code is at https://www.hmailserver.com/forum/viewtopic.php?f=14&t=2960

I have tested this code in hMailServer and with Thunderbird and have it working. However, in deployment I expect I won't have access to an hMailServer, and the mail client is likely to be MS Outlook.

In the source code the author references "oMessage" but, duh, I can't determine what object "oMessage" is supposed to be, and in my adaptation causes an error in the command line string where the error is of course, "object required". Up to that point my vba script is working ok. Since the thread at hMailServer is several years old, I don't expect to get a reply on a question I posted there.

Here is the original source code:

Const g_sPHPPath     = "C:\path\to\php.exe" 
Const g_sScriptPath  = "C:\path\to\script.php" 
Const g_sPipeAddress = "[e-mail]"

Sub OnDeliverMessage(oMessage) 

If g_sPipeAddress = "" Then
    bPipeMessage = True
Else
    bPipeMessage = False

    Set obRecipients = oMessage.Recipients

    For i = 0 to obRecipients.Count - 1
        Set obRecipient = obRecipients.Item(i)

        If LCase(obRecipient.Address) = LCase(g_sPipeAddress) Then
            bPipeMessage = True
        End If
    Next
End If

If bPipeMessage Then
    sCommandLine = "cmd /c type " & g_sDQ & oMessage.Filename & g_sDQ & " | " & g_sDQ & g_sPHPPath & g_sDQ & " " & g_sDQ & g_sScriptPath & g_sDQ 
    Set oShell = CreateObject("WScript.Shell") 
    Call oShell.Run(sCommandLine, 0, TRUE) 
End If

End Sub

And here is my adaptation:

Const g_sPHPPath = "C:\xampp\php\php.exe"
Const g_sScriptPath = "C:\xampp\htdocs\Recycler\test.php"
Const g_sPipeAddress = "[e-mail]"
Const g_sDQ = """"

Sub OnDeliverMessage(oMessage)
Dim Explorer As Outlook.Explorer
Dim CurrentItem As Object

Set Explorer = Application.ActiveExplorer
If Explorer.Selection.Count Then
    Set CurrentItem = Explorer.Selection(1)
End If

If CurrentItem.Class = olMail Then
    Dim sender
    sender = CurrentItem.SenderEmailAddress
End If

If g_sPipeAddress = "" Then
    bPipeMessage = True
Else
    If LCase(sender) = LCase(g_sPipeAddress) Then
        bPipeMessage = True
    End If
End If

If bPipeMessage Then
    sCommandLine = "cmd /c type " & g_sDQ & oMessage.FileName & g_sDQ & " | " & g_sDQ & g_sPHPPath & g_sDQ & " " & g_sDQ & g_sScriptPath & g_sDQ
    Set oShell = CreateObject("WScript.Shell")
    Call oShell.Run(sCommandLine, 0, True)
End If
End Sub

So, can anyone tell me what object oMessage would equate to in the Outlook model? In the cmd string, what should I be looking for in "oMessage.FileName" ?

Answer 1

Did get a reply from hMailServer: "it is the filename that hmailserver creates when receiving a message (the physical .EML file) which is then streamed to clients when clients request it."

So, the argument "oMessage" is passed from hMailServer, but it is not needed in this VBA adaptation.

The solution is simply to save the email to a text file in the body of the procedure, "CurrentItem.SaveAs g_FileName, olTXT", where g_FileName is declared as a constant.

With that, the email has been piped to a text file, where it can be parsed in your language of choice. In my case, PHP where values such as "name", "store number", "phone number", etc are retrieved and saved into a MySQL database.

Finally, the rule applied in Outlook is that when the email is received, it is moved to a folder, and the OnDeliverMessage() script is called.

The revised code then is:

Const g_sPHPPath = "C:\xampp\php\php.exe"
Const g_sScriptPath = "C:\xampp\htdocs\Recycler\handler.php"
Const g_sPipeAddress = "[e-mail]"
Const g_FileName = "C:\tmp\output.txt"
Const g_sDQ = """"

Sub OnDeliverMessage()
Dim Explorer As Outlook.Explorer
Dim CurrentItem As Object

Set Explorer = Application.ActiveExplorer
If Explorer.Selection.Count Then
    Set CurrentItem = Explorer.Selection(1)
End If

CurrentItem.SaveAs g_FileName, olTXT

If CurrentItem.Class = olMail Then
    Dim sender
    sender = CurrentItem.SenderEmailAddress
End If

If g_sPipeAddress = "" Then
    bPipeMessage = True
Else
    If LCase(sender) = LCase(g_sPipeAddress) Then
        bPipeMessage = True
    End If
End If

If bPipeMessage Then
    sCommandLine = "cmd /c type " & g_sDQ & g_FileName & g_sDQ & " | " & g_sDQ & g_sPHPPath & g_sDQ & " " & g_sDQ & g_sScriptPath & g_sDQ
    Set oShell = CreateObject("WScript.Shell")
    Call oShell.Run(sCommandLine, 0, True)
End If
End Sub