Всем доброго дня! Есть макрос отправки по почте,который в качества текста сообщения берет значения из ячейки "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
Astroid1, На данный момент статичная. Единственное, что может меняться, это размерность диапазона вниз. То есть, когда список разрастется, то станет B2:B100. Конечно в идеале, задать условие -Начиная с B2 до последней заполненной ячейки. Но можно и жестко диапазон прописать, если такой вариант затруднителен
Нужно бежать со всех ног, чтобы только оставаться на месте, а чтобы куда-то попасть, надо бежать как минимум вдвое быстрее!
Т.к. файла-примера нет, то ответ на вопрос: можно, вот так:
Код
*сохраняем диапазон с требуемой информаций в объектную переменную
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
Если диапазон не статичен, то предлагаю его цеплять через свойство .UsedRange и кидать в уже обозначенную функцию rangetoHTML. Если приложите пример сделаю вечером.
Вот здесь я выкладывал рабочий вариант: Вставить в письмо Outlook таблицу Excel с форматированием Хотя основа вполне возможно была когда-то взята у того же Рона. Если честно - не помню откуда сама функция, просто валялась в загашнике, вот и выложил. Предположу, что у Вас не работает либо из-за того, что письмо дополнительно форматируется после вставки таблицы, либо не хватает указания формата создаваемого письма:
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.
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
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
может ну его на фиг? вас не насторожил логотип (птица удерживающая крыльями конверт) так письмо никуда не улетит.! тут или расправить крылья, выронить конверт и полететь или камнем рухнуть на землю с крепко обхваченным крыльями конвертом)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!