[VB] Необходимо разослать письма с вложением на базе данной таблицы Excel - Microsoft Office Excel

ziby · 03.01.2019, 16:14

Здравствуйте, уважаемые друзья!

По работе я время от времени сталкиваюсь со следующей задачей:
Есть таблица Excel со столбцами "адрес электронной почты", "обращение", "тема" и т.д. Необходимо разослать письма с вложением на базе данной таблицы. С помощью следующего макроса (готовый макрос для этой задачи я нашел в интернете и чуть-чуть подредактировал под свои нужды) я почти достиг нужного результата:

Код:

Sub Send_Mail_Mass()
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
    Dim lr As Long, lLastR As Long

    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    'произошла ошибка создания объекта - выход
    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, 6).Value 'адрес получателя
            .Subject = Cells(lr, 21).Value 'тема сообщения
            .Body = Cells(lr, 16).Value & Cells(lr, 18).Value 'тема сообщения
            .Attachments.Add Cells(lr, 20).Value
            .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
        End With
    Next lr
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub

Пожалуйста, оформляйте Ваш код согласно правилам.

Макрос позволяет создать n-ное (в соответствии с количеством адресатов в таблице) количество писем в Outlook, которые будут отправлены на адрес из столбца 6. В строчку "тема" будет вставлена тема, указанная в столбце 21. В теле письма будет индивидуальное обращение (Уважаемый господин Иванов, Уважаемая госпожа Петрова и т.д.) из столбца 16 и общий текст из столбца 18. К каждому сообщению будет прикреплен файл из папки, путь к которой указан в столбце 20.

Единственное, мне бы еще хотелось, чтобы вместо общего текста из столбца 18 добавлялась заранее созданная в Outlook подпись. Которая, например, называется "signature". Разница в том, что в подпись можно вставить логотип организации и отформатировать ее необходимым образом (выделить, где надо, жирным шрифтом, отцентрировать и т.д.)

P.S. Возможно, с помощью следующего кода можно добиться чего-то в этом роде:

Код:

Sub SeeSigns()
    Dim sSignPath As String
    Dim sF
    sSignPath = Environ("appdata") & "\Microsoft\Signatures\" '"
    sF = Dir(sSignPath & "*.txt")
    Do While sF <> ""
        MsgBox sF, vbInformation, "www.excel-vba.ru"
        sF = Dir
    Loop
End Sub

Пожалуйста, оформляйте Ваш код согласно правилам.

Но моих знаний не хватает, чтобы понять, подходит ли код для решения моей задачи и - тем более - интегрировать его в основной код.

alex777555 · 05.01.2019, 01:45

Можно форматировать так:

Код:

 .BodyFormat = 2
  .HTMLBody = "<html><body><div>" & _
"<h4><span style=""color: rgb(255, 0, 0); font-weight: bold;"">ПЕРВАЯ СТРОКА,красная и жирная<br>" & _
"</span></h4></div>" & _
"<h2>The <span style=""color: rgb(51, 204, 0);"">body </span>of this <span" & _
"style=""color: rgb(51, 102, 255);"">message will appear</span> in <span" & _
"style=""color: rgb(255, 0, 0);"">HTML</span>.</h2></body></html>"

03.01.2019, 16:14	#1
ziby Новичок Джуниор Регистрация: 03.01.2019 Сообщений: 1	[VB] Необходимо разослать письма с вложением на базе данной таблицы Excel Здравствуйте, уважаемые друзья! По работе я время от времени сталкиваюсь со следующей задачей: Есть таблица Excel со столбцами "адрес электронной почты", "обращение", "тема" и т.д. Необходимо разослать письма с вложением на базе данной таблицы. С помощью следующего макроса (готовый макрос для этой задачи я нашел в интернете и чуть-чуть подредактировал под свои нужды) я почти достиг нужного результата: Код: Sub Send_Mail_Mass() Dim objOutlookApp As Object, objMail As Object Dim sTo As String, sSubject As String, sBody As String, sAttachment As String Dim lr As Long, lLastR As Long Application.ScreenUpdating = False On Error Resume Next 'пробуем подключиться к Outlook, если он уже открыт Set objOutlookApp = GetObject(, "Outlook.Application") Err.Clear 'Outlook закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If 'произошла ошибка создания объекта - выход 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, 6).Value 'адрес получателя .Subject = Cells(lr, 21).Value 'тема сообщения .Body = Cells(lr, 16).Value & Cells(lr, 18).Value 'тема сообщения .Attachments.Add Cells(lr, 20).Value .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Next lr Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub Пожалуйста, оформляйте Ваш код согласно правилам. Макрос позволяет создать n-ное (в соответствии с количеством адресатов в таблице) количество писем в Outlook, которые будут отправлены на адрес из столбца 6. В строчку "тема" будет вставлена тема, указанная в столбце 21. В теле письма будет индивидуальное обращение (Уважаемый господин Иванов, Уважаемая госпожа Петрова и т.д.) из столбца 16 и общий текст из столбца 18. К каждому сообщению будет прикреплен файл из папки, путь к которой указан в столбце 20. Единственное, мне бы еще хотелось, чтобы вместо общего текста из столбца 18 добавлялась заранее созданная в Outlook подпись. Которая, например, называется "signature". Разница в том, что в подпись можно вставить логотип организации и отформатировать ее необходимым образом (выделить, где надо, жирным шрифтом, отцентрировать и т.д.) P.S. Возможно, с помощью следующего кода можно добиться чего-то в этом роде: Код: `Sub SeeSigns() Dim sSignPath As String Dim sF sSignPath = Environ("appdata") & "\Microsoft\Signatures\" '" sF = Dir(sSignPath & ".txt") Do While sF <> "" MsgBox sF, vbInformation, "www.excel-vba.ru" sF = Dir Loop End Sub` Пожалуйста, оформляйте Ваш код согласно правилам.* Но моих знаний не хватает, чтобы понять, подходит ли код для решения моей задачи и - тем более - интегрировать его в основной код. Последний раз редактировалось Вадим Мошев; 03.01.2019 в 16:37.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Макрос для массовой рассылки почты из таблицы Excel с вложением	Hemezida	Microsoft Office Excel	3	21.08.2015 15:59
Отправка письма с вложением	flance	PHP	0	21.05.2013 13:43
Отправить диаграмму из Excel в Outlook (не вложением) VBA	Kycaka	Microsoft Office Excel	13	15.11.2012 14:45
Отправка письма с вложением Delphi	Aero1	Помощь студентам	2	11.06.2010 22:26
Отправка письма с вложением	Stanislav	PHP	1	06.04.2009 13:44