Здравствуйте, Уважаемые!
Столкнулся со следующей проблемой.
Из общего пула входящей почтовой информации (подчеркиваю, именно почтовой) кодом макроса, анализируя последовательно все содержимое в папке "Входящие" каким-то удивительным образом вычисляю сообщения, которые требуют определенной обработки.
Успешно произведя экзекуции над этим сообщением, формирую ответ (именно ответ, а не создаю новое сообщение) и отправляю адресату.
Теперь лишь хочу это полученное почтовое сообщение и сформированный и отправленный программным путем свой ответ на него перенести в специально созданные хранилища информации, например, полученное письмо переместить в папку "Входящие" -> "Тема" -> "Обработанные", а ответ в папку "Входящие" -> "Тема" -> "Отвечено" программным методом.
Поскольку эти взаимосвязанные почтовые сообщения я воспринимаю как беседа, то для идентификации этих сообщений я использую свойство ConversationID.
Осознавая, что появление ответа в папке "Отправленные" занимает некоторое количество времени, специально ввожу бесконечный цикл, предусматривая принудительный выход из него при выполнении определенных условий, важнейшим из которых является обнаружение сообщения с нужным свойством ConversationID.
И Outlook прекрасно меня понимает, чего я от него хочу, когда я пошагово прохожу по коду, но стоит это запустить на автомате, он зацикливается, пока не приобретает истинность условия превышения заданного лимита времени.
При тестировании сам на себе, обратил внимание, что пока я не получу системного уведомления, что поступило письмо в виде ответа, то макрос, код которого привожу ниже, входит в состояние рекурсии.
Помогите, люди добрые, разобраться с проблемой. Объясните, чего я недопонимаю и/или не догоняю для решения своей задачи.
Код:
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
Sub Testing()
Dim oOutlook As New Outlook.Application
Dim oNamespace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim oItem As Object
Dim oMailReply As MailItem
Dim I As Integer, J As Integer, IDConversatMsg As String
dim StartTimer as Single, NextValTimer as Single
Set oNamespace = oOutlook.GetNamespace("MAPI")
Set myFolder = oNamespace.GetDefaultFolder(olFolderInbox)
Set myFolderSend = oNamespace.GetDefaultFolder(olFolderSentMail)
Set myFolderArhiveIn = oNamespace.GetDefaultFolder(olFolderInbox).Folders("Тема").Folders("Обработанные")
Set myFolderArhiveTo = oNamespace.GetDefaultFolder(olFolderInbox).Folders("Тема").Folders("Отвечено")
Set oItem = myFolder.Items
Set oItemReply = myFolderSend.Items
For I = oItem.Count To 1 Step -1
Set oMailReply = oItem(I).Reply
oMailReply.HTMLBody = "Спасибо! Получено и обработано. " & vbCrLf & oMailReply.HTMLBody
oMailReply.Save 'сохранение созданного ответного сообщения
IDConversatMsg = oItem(I).ConversationID
oMailReply.Send
'Отслеживание появления ответного почтового сообщения в папке "Отправленные"
StartTimer = Timer
Do While True
DoEvents
For J = oItemReply.Count To 1 Step -1
If oItemReply(J).ConversationID = IDConversatMsg Then
oItemReply(J).Move myFolderArhiveTo
oItem(I).Move myFolderArhiveIn
GoTo 1:
End If
Next
NextValTimer = Timer
If (NextValTimer - StartTimer) / 60 > 3 Then
MsgBox "ПРОБЛЕМЫ!!!"
GoTo 1:
End If
Loop
Next
1: Set oOutlook.ActiveExplorer.CurrentFolder = myFolderArhiveTo
End Sub
