Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Неверная работа макроса отправки почты
 
#1
09.12.2019 00:29:14
Господа, взываю к вашей помощи.

На просторах сети нарыл много всевозможных решений по вопросу отправки почты из 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
 
 
 
#2
09.12.2019 06:23:59
Антон91, ваш макрос работает, если оставить эти строки. Ищите проблему в остальных строках.
Код
Sub mail()
 Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
    On Error Resume Next
        Set objOutlookApp = CreateObject("Outlook.Application")
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.createitem(0)
    With objMail
        .display
    End With
    Set objOutlookApp = Nothing: Set objMail = Nothing
End Sub
 
 
 
#3
09.12.2019 07:32:02
Закоменте эту часть , и все получится

Код
If Dir(sAttachment, 16) <> "" Then
            .Attachments.Add sAttachment 'просто вложение
            'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
        End If

Также адрес получателя нужно просто емейл в ковычках вот так :
Код
sTo = "ag@yandex.ru"
 
 
 
#4
09.12.2019 08:34:34
Цитата
Антон91 написал:
но ничего не происходит, письмо не создается
в черновиках не пробовали смотреть? Может на момент запуска кода Outlook был не запущен и тогда письмо отображается и Outlook закрывается, никакой отправки нет. Попробуйте убрать эти строки:
Код
Set objOutlookApp = Nothing: Set objMail = Nothing
это не даст закрыться приложению Outlook и Вы увидите свое созданное письмо.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#5
09.12.2019 12:10:57
restation, Да, помогло, спасибо вам! Правильно ли я понял, раз не указано вложение, возникала какая то ошибка? Адрес в самом редакторе указан верно, видимо какие то ошибка переноса.
 
 
 
Страницы: 1
Наверх