Страницы: 1
RSS
Отправка письма макросом нескольким получателям из диапазона ячеек.
 
Добрый день уважаемые пользователи форума.

Подскажите, пожалуйста, по следующему вопросу:
У меня есть макрос отправки писем с вложением таблицы в тело письма. Макрос работает корректно при указании одного получателя см. скриншот №2, при этом отправить письмо нужно сразу нескольким получателям и при прописывании диапазона ячеек получателей происходит ошибка .To = Range("A12:A15").Value  см. скриншот №3.


Подскажите как правильно прописать код получателя, что бы в получатели в письмо подставлялось сразу несколько получателей из диапазона ячеек A12:A15 см. скриншот №1.  

Пример файла и скриншоты прикрепляю во вложении.
Код
Sub ТО_ПК_Кнопка()
    Dim objOutlookApp As Object, objMail As Object
 
    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
    On Error GoTo 0
    &#39;создаем сообщение
    With objMail
        .To = Range("A12").Value
        .Subject = "Текст"
        .BodyFormat = 2  &#39;olFormatHTML - формат HTML
        .HTMLBody = ConvertRngToHTM(Range("A2:M6"))
        .Display &#39;отображаем сообщение
        .ReadReceiptRequested = True
        objMail.Importance = 2 &#39;olImportanceHigh
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating= True
End Sub

Скрытый текст

Заранее благода
 
Код
    Dim arr, mailboxes As String
    arr = Range("A12:A15").Value
    For i = 1 To UBound(arr)
        If Len(mailboxes) = 0 Then
            mailboxes = arr(i, 1)
        Else
            mailboxes = mailboxes & "; " & arr(i, 1)
        End If
    Next i
    
    With objMail
        .to = mailboxes
        .Subject = "Текст"
        .BodyFormat = 2  'olFormatHTML - формат HTML
        .HTMLBody = ConvertRngToHTM(Range("A2:M6"))
        .Display 'отображаем сообщение
        .ReadReceiptRequested = True
        objMail.Importance = 2 'olImportanceHigh
    End With
 
Код
Dim rngtoEmail As String, EmailAddr As String
Dim EmailCell as Range
Set EmailCell = Application.InputBox("Выберите", , , , , , , 8)
For Each i In EmailCell
rngtoEmail = rngtoEmail & ";" & i
Next i
rngtoEmail = Right(rngtoEmail, Len(rngtoEmail) - 1)
Добавьте в код вот этот фрагмент. Далее .To = rngtoEmail.
Источник
https://www.extendoffice.com/documents/excel/3559-excel-send-email-to-multiple-recipients.html
Изменено: artemkau88 - 24.09.2020 17:35:58
 
Спасибо за помощь)
Страницы: 1
Наверх