Какой объект является «oMessage»? в почтовом канале hMailServer?

Я адаптирую код hMailServer, который я нашел, к MS Outlook vba. Исходный код находится на https://www.hmailserver.com/forum/viewtopic.php?f=14&т = 2960

Я проверил этот код в hMailServer и Thunderbird, и он работает. Однако при развертывании я ожидаю, что у меня не будет доступа к hMailServer, а почтовым клиентом скорее всего будет MS Outlook.

В исходном коде автор ссылается на «oMessage», но я не могу определить, какой объект должен быть «oMessage», и в моей адаптации вызывает ошибку в строке командной строки, где ошибка, конечно, «object» требуется». До этого момента мой скрипт VBA работал нормально. Поскольку теме на hMailServer уже несколько лет, я не ожидаю получить ответ на вопрос, который я там разместил.

Вот оригинальный исходный код:

Const g_sPHPPath     = "C:\path\to\php.exe"Const g_sScriptPath  = "C:\path\to\script.php"Const g_sPipeAddress = "[email protected]"
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 = "[email protected]"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, что я должен искать в «oMessage.FileName»?

0

Решение

Получил ответ от hMailServer: «это имя файла, которое hmailserver создает при получении сообщения (физического файла .EML), которое затем передается клиентам при его запросе».

Таким образом, аргумент «oMessage» передается из hMailServer, но он не нужен в этой адаптации VBA.

Решение состоит в том, чтобы просто сохранить электронное письмо в текстовом файле в теле процедуры «CurrentItem.SaveAs g_FileName, olTXT», где g_FileName объявлено как константа.

При этом электронное письмо было передано в текстовый файл, где его можно проанализировать на выбранном вами языке. В моем случае PHP, где такие значения, как «имя», «номер магазина», «номер телефона» и т. Д., Извлекаются и сохраняются в базе данных MySQL.

Наконец, правило, применяемое в Outlook, заключается в том, что при получении электронного письма оно перемещается в папку и вызывается сценарий OnDeliverMessage ().

Пересмотренный код тогда:

Const g_sPHPPath = "C:\xampp\php\php.exe"Const g_sScriptPath = "C:\xampp\htdocs\Recycler\handler.php"Const g_sPipeAddress = "[email protected]"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
0

Другие решения

Других решений пока нет …

По вопросам рекламы [email protected]