Страницы: 1
RSS
Оправка по почте макросом диапазона ячеек, в качестве текста сообщения
 
Всем доброго дня!
Есть макрос отправки по почте,который в качества текста сообщения берет  значения из ячейки "B2"

Код
Sub SendMail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    
     
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")   'запускаем Outlook в скрытом режиме
    OutApp.Session.Logon
    On Error GoTo cleanup  'если не запустился - выходим
    Set OutMail = OutApp.CreateItem(0)   'создаем новое сообщение
    On Error Resume Next
    'заполняем поля сообщения
    With OutMail
        .To = Range("G2").Value ' адрес (кому)
        .Subject = Range("H2").Value 'Тема письма
       .Body = Range("B2").Value 'текст сообщения
        .Attachments.Add Range("I2").Value ' путь к файлу
        'команду Send можно заменить на Display, чтобы посмотреть сообщение перед отправкой
        .Send
    End With
 
    On Error GoTo 0
    Set OutMail = Nothing
 
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub


Как изменить диапазон, чтобы текст сообщения отправлялся не только из B2, а формировался  из диапазона B2:B34

Заранее благодарен.
Изменено: Dyroff - 14.04.2017 11:13:32
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Вопрос - та область, которая должна попасть в .Body посьма MS Outlook переменная или статичная?
 
Astroid1,  На данный момент статичная. Единственное, что может меняться, это размерность диапазона вниз. То есть,  когда список разрастется, то станет B2:B100. Конечно в идеале, задать условие -Начиная с B2  до последней заполненной ячейки. Но можно и жестко диапазон прописать, если такой вариант затруднителен
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 

Я делаю это через функцию rangetoHTML (автор Ron De Bruin).

https://www.rondebruin.nl/win/s1/outlook/bmail2.htm

Т.к. файла-примера нет, то ответ на вопрос: можно, вот так:

Код
*сохраняем диапазон с требуемой информаций в объектную переменную

Dim rnGAttach As Range 'имя объёктной переменной
Set rnGAttach = ThisWorkbook.Worksheets("Ваш лист").Range("B2:B34") 'вместо "ваш лист' укажите имя листа, с которого сохраняется диапазон ячеек в .Body 
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
    .To = ThisWorkbook.Sheets("Sheet2").Range("C1").Value 'Это если адрес получателя статичен / не запрашиваете у пользователя через форму / inbox или указывается непосредственно в книге
    .CC = ""
    .BCC = ""
    .Subject = "This is the Subject line" 'тема письма
    .HTMLBody = RangetoHTML(rnGAttach) 'тело письма. в данном случае это сохранённый нами в объектную переменную диапазон и сконвертированный в html удобоваримый формат
    .Display 'или .Send - чтобы отправить сразу
End With
Изменено: Astroid1 - 14.04.2017 11:12:51
 
Если диапазон не статичен, то предлагаю его цеплять через свойство .UsedRange и кидать в уже обозначенную функцию rangetoHTML.
Если приложите пример сделаю вечером.
 
Спасибо, я попробую. На всякий случай прикрепил в начальное сообщение файл.
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Astroid1, Не работает метод через rangetoHTML
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Вот здесь я выкладывал рабочий вариант: Вставить в письмо Outlook таблицу Excel с форматированием
Хотя основа вполне возможно была когда-то взята у того же Рона. Если честно - не помню откуда сама функция, просто валялась в загашнике, вот и выложил.
Предположу, что у Вас не работает либо из-за того, что письмо дополнительно форматируется после вставки таблицы, либо не хватает указания формата создаваемого письма:
Код
.BodyFormat = 2
Изменено: The_Prist - 14.04.2017 15:53:51
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist, Спасибо, в очередной раз выручаете меня. Отличная статья! Только у меня все ещё проще, мне нужно без форматирования, просто текст, который там содержится. Но я обязательно изучу Вашу статью.
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Прошу прощения - вчера не успел сделать (поздно пришёл, пятница - все таки :) )

Готово, вот код:
Код
Dim adressTo$, fname$, theme$, Disclaimer$
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim rng As Range

Set sh = ThisWorkbook.Sheets("Для исполнения")

With Application
    .DisplayAlerts = False
    .EnableEvents = False
    .ScreenUpdating = False
End With

With sh
    .AutoFilterMode = False
    .Range("$A$1:$B$1").AutoFilter Field:=2, Criteria1:="<>"
End With

Set rng = sh.Range("A1").CurrentRegion

With sh
    adressTo = .Range("G2").Value
    theme = .Range("H2").Value
    Disclaimer = .Range("J2").Value
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next

With OutMail
    .To = adressTo
    .cc = ""
    .BCC = ""
    .Subject = theme
    .HTMLBody = "<p style=font-size:10pt;font-family:Calibri;>" & Disclaimer & _
        RangetoHTML(rng)
    .Display 'или Send - чтобы отправить сразу, без предварительного просмотра сформированного сообщения Outlook
End With

Set OutMail = Nothing
Set OutApp = Nothing
sh.AutoFilterMode = False
ThisWorkbook.Save

MsgBox "Письмо успешно сформировано и направлено! ", vbInformation, "Подтверждение отправки сообщения"

With Application
    .EnableEvents = True
    .ScreenUpdating = True
    .DisplayAlerts = True
End With


Теперь по примеру:
1. Будет формироваться всегда 1 сообщение всегда одному получателю, которого мы указываем в диапазоне G2;
2. Если нужна другая логика (1 письмо = 1 строка таблицы, то предлагаю использовать цикл For Each или Do while) - если надо так, то могу сделать;
3. А что собираетесь сохранять в приложение к письму? Это всегда один и тот-же файл или подразумевается возможность выбора? Если вы сталкиваетесь с необходимостью менять приложенный файл, то предлагаю использовать метод GetOpenFIlename.

Пример по П.3 (с маской для файлов Excel):
Код
Fname = Application.GetOpenFilename( _
            FileFilter:="XLS Files (*.xls),*.xls,CSV Files (*.csv),*.csv", _
            Title:="Пожалуйста, выберите файл для вложения", _
            MultiSelect:=True)
Изменено: Astroid1 - 17.04.2017 11:27:31
 
Astroid1,
Огромное спасибо!
Завтра проверю- отпишусь!
По ответам на вопросы:
3) Прикреплять к письму файлы нет необходимости, так как вся нужная информация уйдет в теле письма. Именно этого я и хотел добиться, так как получатель не может работать с прикрепленным файлом, а может работать только с информацией в теле письма.
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Тогда все проще:
Код
.Body = Range("B2:B34")
'сама функция
Function GetAllText(rng As Range)
    Dim lr As Long, lc As Long, arr
    Dim res As String
    
    arr = rng.Value
    If Not IsArray(arr) Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = rng.Value
    End If
    For lr = 1 To UBound(arr, 1)
        For lc = 1 To UBound(arr, 2)
            If lc = 1 Then
                res = res & arr(lr, lc)
            Else
                res = res & vbTab & arr(lr, lc)
            End If
        Next
        res = res & vbNewLine
    Next
    GetAllText = res
End Function
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist,  И Вам ещё раз спасибо, за активное участие и отзывчивость:)
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Astroid1, Отлично работает. Спасибо)
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
 
Возможно ли поменять этот код, что бы запускался Thunderbird?
 
может ну его на фиг? вас не насторожил логотип (птица удерживающая крыльями конверт)
так письмо никуда не улетит.!
тут
или расправить крылья, выронить конверт и полететь
или камнем рухнуть на землю с крепко обхваченным крыльями конвертом)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
Страницы: 1
Наверх