Доброго здоровья всем
Ребят, ну выручайте, пожалуйста!
Есть макрос по отправке писем:
| Код |
|---|
Sub Mail()
Dim i As Long
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
Application.ScreenUpdating = False
On Error Resume Next
Set objOutlookApp = GetObject(, "Outlook.Application")
Err.Clear
If objOutlookApp Is Nothing Then
Set objOutlookApp = CreateObject("Outlook.Application")
End If
objOutlookApp.Session.Logon
For i = 1 To 9
Cells(10, 4) = i
ActiveWorkbook.Save
Set objMail = objOutlookApp.CreateItem(0)
If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
sTo = Cells(i, 3)
sSubject = "оплата"
sAttachment = ActiveWorkbook.FullName
With objMail
.To = sTo
.Subject = sSubject
.Attachments.Add sAttachment
.Send
End With
Next i
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub
|
Работает как хотелось вроде бы, но собственно в чём проблема то: задачи создаются, письма всем отправляются, но макрос справляется настолько быстро, что он закрывает в конце аутлук и не все письма уходят адресатам, то есть по факту до конца процедуры успевает отправиться, например, писем 6 из 9, а остальные виснут в исходящих и дожидаются нового сеанса! Приходиться открывать аутлук вручную и дожидаться пока все исходящие разлетятся.
Как же всё таки объяснить ему закрыть приложение только с пустой папкой "исходящие"?
)
