doudang1052 2015-12-02 17:20
浏览 103
已采纳

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

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 = "something@yourdomain.com"

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 = "someAddress@mail.net"
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" ?

  • 写回答

1条回答 默认 最新

  • 普通网友 2015-12-03 15:13
    关注

    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 = "someone@mail.net"
    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
    
    本回答被题主选为最佳回答 , 对您是否有帮助呢?
    评论

报告相同问题?

悬赏问题

  • ¥15 ikuai客户端多拨vpn,重启总是有个别重拨不上
  • ¥20 关于#anlogic#sdram#的问题,如何解决?(关键词-performance)
  • ¥15 相敏解调 matlab
  • ¥15 求lingo代码和思路
  • ¥15 公交车和无人机协同运输
  • ¥15 stm32代码移植没反应
  • ¥15 matlab基于pde算法图像修复,为什么只能对示例图像有效
  • ¥100 连续两帧图像高速减法
  • ¥15 如何绘制动力学系统的相图
  • ¥15 对接wps接口实现获取元数据