Подскажите, пожалуйста, как- то возможно сделать макрос или видоизменить мой макрос, чтобы он отправлял письмо с определенным текстом(+темой) и подцеплял файл из папки(если файл открыт- то нужно сохранить все изменения). то есть мне необходимо, чтобы каждую пятницу в 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]
добрый день!
Подскажите, пожалуйста, как- то возможно сделать макрос или видоизменить мой макрос, чтобы он отправлял письмо с определенным текстом(+темой) и подцеплял файл из папки(если файл открыт- то нужно сохранить все изменения). то есть мне необходимо, чтобы каждую пятницу в 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