Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Отправка сообщения в заданное время - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
Отправка сообщения в заданное время
drovosek777 Дата: Понедельник, 16.11.2020, 18:26 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
добрый день!

Подскажите, пожалуйста, как- то возможно сделать макрос или видоизменить мой макрос, чтобы он отправлял письмо с определенным текстом(+темой) и подцеплял файл из папки(если файл открыт- то нужно сохранить все изменения).
то есть мне необходимо, чтобы каждую пятницу в 18:00 отправлялся отчет руководителю.

вот мой макрос, который это делает, но вручную:
[vba]
Код
Sub Отправка_отчета()

    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
    Dim objTmpMail As Object 'временное письмо для создания подписи

    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear '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 = "Email2@email.ru"    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sSubject = "Отправка отчета"    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = "Добрый день! Высылаю отчет."    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
    sAttachment = "\\...\Отчет.xlsx"    'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)

    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = "" 'адрес для копии
        .BCC = "Email@email.ru" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .body = sBody 'текст сообщения
        .HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
        .Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
        'добавляем подпись к письму
        'создаем новое письмо
        Set objTmpMail = objOutlookApp.CreateItem(0)
        'отображаем его - у него появится подпись
        objTmpMail.Display
        'теперь к нашему текущему(рабочему) письму просто добавляем текст из временного
        objMail.body = objMail.body & objTmpMail.body
        'удаляем временное письмо
        objTmpMail.Delete

        .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With

    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
[/vba]


Office 2019

Сообщение отредактировал drovosek777 - Понедельник, 16.11.2020, 18:43
 
Ответить
Сообщениедобрый день!

Подскажите, пожалуйста, как- то возможно сделать макрос или видоизменить мой макрос, чтобы он отправлял письмо с определенным текстом(+темой) и подцеплял файл из папки(если файл открыт- то нужно сохранить все изменения).
то есть мне необходимо, чтобы каждую пятницу в 18:00 отправлялся отчет руководителю.

вот мой макрос, который это делает, но вручную:
[vba]
Код
Sub Отправка_отчета()

    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
    Dim objTmpMail As Object 'временное письмо для создания подписи

    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear '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 = "Email2@email.ru"    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sSubject = "Отправка отчета"    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = "Добрый день! Высылаю отчет."    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
    sAttachment = "\\...\Отчет.xlsx"    'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)

    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = "" 'адрес для копии
        .BCC = "Email@email.ru" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .body = sBody 'текст сообщения
        .HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
        .Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
        'добавляем подпись к письму
        'создаем новое письмо
        Set objTmpMail = objOutlookApp.CreateItem(0)
        'отображаем его - у него появится подпись
        objTmpMail.Display
        'теперь к нашему текущему(рабочему) письму просто добавляем текст из временного
        objMail.body = objMail.body & objTmpMail.body
        'удаляем временное письмо
        objTmpMail.Delete

        .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With

    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
[/vba]

Автор - drovosek777
Дата добавления - 16.11.2020 в 18:26
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!