The_Prist, да все поправил, ошибок не выдает, но письма без вложений
| Путь к вложению |
| E:\Новая папка\1.xlsx |
| E:\Новая папка\OOO__Lider_ProM_.xlsx |
| E:\Новая папка\ООО__Лидер_ПроМ_.xlsx |
Option Explicit
Sub Send_Mail_Mass()
Dim objOutlookApp As Object, objMail As Object
Dim lr As Long, lLastR As Long
Application.ScreenUpdating = False
On Error Resume Next
Set objOutlookApp = CreateObject("Outlook.Application")
If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
objOutlookApp.Session.Logon
lLastR = Cells(Rows.Count, 1).End(xlUp).Row 'определяем последнюю заполненную ячейку в столбце А
'цикл от второй строки(начало данных с адресами) до последней ячейки таблицы
For lr = 2 To lLastR
Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение
'создаем сообщение
With objMail
If Dir(Cells(lr, 4), 16) = "" Then
msgbox "Файл не найден: " & Cells(lr, 4), vbInformation
End If
.To = Cells(lr, 1) 'адрес получателя
.Subject = Cells(lr, 2) 'тема сообщения
.Body = Cells(lr, 3) 'текст сообщения
.Attachments.Add Cells(lr, 4)
.Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
End With
Next lr
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub
