Question

我正在调整我发现的一些hMailServer代码到MS Outlook vba。源代码位于https://www.hmailserver.com/forum/viewtopic.php?f=14&t=2960

我已经在hMailServer和Thunderbird中测试了这段代码并让它运行起来。但是，在部署中我希望我无法访问hMailServer，而邮件客户端很可能是MS Outlook。

在源代码中，作者引用了＆＃34; oMessage＆＃34;但是，呃，我无法确定什么对象＆＃34; oMessage＆＃34;应该是，并且在我的改编中导致命令行字符串中的错误，其中错误当然是＆＃34;对象需要＆＃34;。到那时为止，我的vba脚本正常运行。由于hMailServer上的帖子已有几年的历史，我不希望得到我在那里发布的问题的回复。

以下是原始源代码：

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

这是我的改编：

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

那么，谁能告诉我oMessage在Outlook模型中等同于什么对象？在cmd字符串中，我应该在＆＃34; oMessage.FileName＆＃34;中找到什么？？

Answer 1

从hMailServer获得回复：＆＃34;它是hmailserver在接收消息（物理.EML文件）时创建的文件名，然后在客户请求时将其传输到客户端。＆＃34;

所以，论证＆＃34; oMessage＆＃34;从hMailServer传递，但在此VBA适配中不需要它。

解决方案只是将电子邮件保存到过程正文中的文本文件中，＆＃34; CurrentItem.SaveAs g_FileName，olTXT＆＃34;，其中g_FileName被声明为常量。

通过这种方式，电子邮件已通过管道传输到文本文件，可以使用您选择的语言进行解析。在我的例子中，PHP检索诸如＆＃34; name＆＃34;，＆＃34; store number＆＃34;，＆＃34;电话号码＆＃34;等等的值，并将其保存到MySQL数据库中。

最后，Outlook中应用的规则是，当收到电子邮件时，它会被移动到一个文件夹，并且会调用OnDeliverMessage（）脚本。

修改后的代码是：

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

什么对象是＆＃34; oMessage＆＃34;在hMailServer电子邮件管道？

1 个答案: