Господа, взываю к вашей помощи.
На просторах сети нарыл много всевозможных решений по вопросу отправки почты из excel. Сработал только один вариант (ниже) и только один раз. Далее код отрабатывает, но ничего не происходит, письмо не создается.
Не понимаю в чем проблема. Прошу помощи (офис 2019).
На просторах сети нарыл много всевозможных решений по вопросу отправки почты из excel. Сработал только один вариант (ниже) и только один раз. Далее код отрабатывает, но ничего не происходит, письмо не создается.
Не понимаю в чем проблема. Прошу помощи (офис 2019).
Код |
---|
Sub mail() Dim objOutlookApp As Object, objMail As Object Dim sTo As String, sSubject As String, sBody As String, sAttachment As String Application.ScreenUpdating = False On Error Resume Next 'Пробуем подключиться к Outlook если уже открыт Set objOutlookApp = GetObject(, "Outlook.Application") Err.Clear 'Outlook Outlook закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If objOutlookApp.Session.Logon Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'если не удалось создать приложение или экземпляр сообщения выходим If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub sTo = "[URL=mailto:ag@yandex.ru]ag@yandex.ru[/URL]" 'адрес, можно заменить sTo= Range("A1").Value) sSubject = "fdf" 'Тема, можно заменить - sSubject = Range("A2").Value) sBody = "sfdfs Excel-VBA" 'Текст можно заменить - sBody = Range("A3").Value) 'sAttachment = "C:\Temp\?????1.xls" 'вложение, можно указать путь к файлу - sAttachment = Range("A4").Value) 'создаем сообщение With objMail .To = sTo 'адрес .CC = "" 'копия .BCC = "" 'скрытая .Subject = sSubject 'тема .Body = sBody 'текст '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) 'добавляем вложение, если файл по указанному пути существует(dir проверяет это) If Dir(sAttachment, 16) <> "" Then .Attachments.Add sAttachment 'просто вложение 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName End If .Display 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub |