| Главная » Статьи » Готовые макросы |
Outlook отправка письма
| Отправка текущего активного листа. Sub Send_Email_ActiveSheet() Dim objOutlookApp As Object, oMail As Object Application.ScreenUpdating = False Application.DisplayAlerts = False wsPath = Environ("TEMP") & "\" & ActiveSheet.Name & ".xlsx" ActiveSheet.Copy ActiveWorkbook.SaveAs wsPath ActiveWorkbook.Close 'подключаемся к Outlook On Error Resume Next Set objOutlookApp = GetObject(, "Outlook.Application") If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") objOutlookApp.Session.Logon 'формируем сообщение и прикрепляем к нему файл Set oMail = objOutlookApp.CreateItem(0) oMail.Attachments.Add wsPath .To = sh1.Cells(i, 5).Value 'адрес получателя .CC = Cells(i, 7).Value 'адрес для копии .Subject = sh1.Cells(1, 8) 'тема сообщения .HTMLBody = sh1.Cells(1, 11) 'текст сообщения .FlagRequest = "К исполнению" 'адресаты получат флажок - "К исполнению" .Importance = 2 'важность (2- высокая, 1 - обычная, 0 - низкая) oMail.display Kill wsPath 'удаляем временный файл Set oMail = Nothing Set objOutlookApp = Nothing Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub | |
| Просмотров: 542 | | |
| Всего комментариев: 0 | |