Макрос для массовой рассылки почты из таблицы Excel с вложением

[Hemezida]

Доброго дня! У меня уже налажена система заполнения документа из таблицы Excel, теперь очень хочется, чтобы это все рассылалось потребителям на почту.
Я нашла макрос который без проблем создает письма, только вот почему-то вложения не хочет прикреплять. Подскажите по какой причине это может быть?
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
.To = Cells(lr, 9)
.Subject = Cells(lr, 12)
.Body = Cells(lr, 13)
.Attachments.Add Cells(lr, 14)
.Display

End With
Next lr


Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub

[27102014]

добавьте код

 SM.Attachments.Add ("X:\wwwww.txt") 'адрес вложения

перед

SM.Display

Хотя у Вас это все есть, проверьте адрес вложения, ошибка в имени вложений

[Hemezida]

В том-то и дело, что если создавать письма этим макросом , то вложения с тем путем , нормально попадают в письмо.
Думаю, просто закатать этот макрос под цикл. Но все равно интересно, что с тем макросом не так
Sub Send_Mail()
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 = CreateObject("Outlook.Application")
objOutlookApp.Session.Logon
Set objMail = objOutlookApp.CreateItem(0)
If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub

sTo = Range("I2").Value '
sSubject = Range("L2").Value
sBody = Range("M2").Value
sAttachment = Range("N2").Value


With objMail
.To = sTo
.CC = ""
.BCC = ""
.Subject = sSubject
.Body = sBody
.Attachments.Add sAttachment
.Display ',
End With

Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub

[EducatedFool]

Если надоест разбираться с макросами, - можете попробовать готовое решение для рассылки через Аутлук:
http://excelvba.ru/programmes/FillDocuments

можно динамически формировать тему и текст письма, прикреплять разные файлы (в т.ч. и динамически создаваемые по шаблонам), можно задать временно интервал между отправляемыми письмами.