Название: Сохранить и отправить лист из книги в формате pdf на почту
Отправлено: Ибрагим от 11.06.2021, 11:11:41
Я на этом сайте нашёл макрос, но у меня почтовая программа не Outlook, а Mozilla Thunderbird, как с ней настроить этот макрос? Option Explicit Sub Send_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 закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If 'раскомментировать строку, если в Outlook несколько учетных записей и нужно подключиться к конкретной(только если Outlook закрыть) ' [параметры]: Session.Logon "имя профиля","пароль",[показывать окно выбора профиля], [запускать в новой сессии] 'objOutlookApp.Session.Logon "profile","1234",False, True Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'если не получилось создать приложение или экземпляр сообщения - выходим If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub sTo = "AddressTo@mail.ru" 'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value) sSubject = "Автоотправка" 'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value) sBody = "Привет от 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 sAttachment <> "" Then If Dir(sAttachment, 16) <> "" Then .Attachments.Add sAttachment 'просто вложение 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName End If End If .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub
Название: Re:Сохранить и отправить лист из книги в формате pdf на почту
Отправлено: Дмитрий Щербаков(The_Prist) от 11.06.2021, 11:48:12
как с ней настроить этот макрос? Никак. И насколько я знаю у Mozilla Thunderbird нет своей библиотеки, к которой можно было бы получить доступ через CreateObject.
Название: Re:Сохранить и отправить лист из книги в формате pdf на почту
Отправлено: Ибрагим от 11.06.2021, 13:34:50
А если через Outlook, то как сделать, чтобы этот макрос отравлял лист из файла Эксель в формате pdf?
Название: Re:Сохранить и отправить лист из книги в формате pdf на почту
Отправлено: Ибрагим от 11.06.2021, 13:37:31
Я на этом сайте нашёл макрос, как сделать так, чтобы он отправлял лист из файла Эксель в формате pdf? Option Explicit Sub Send_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 закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If 'раскомментировать строку, если в Outlook несколько учетных записей и нужно подключиться к конкретной(только если Outlook закрыть) ' [параметры]: Session.Logon "имя профиля","пароль",[показывать окно выбора профиля], [запускать в новой сессии] 'objOutlookApp.Session.Logon "profile","1234",False, True Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'если не получилось создать приложение или экземпляр сообщения - выходим If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub sTo = "AddressTo@mail.ru" 'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value) sSubject = "Автоотправка" 'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value) sBody = "Привет от 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 sAttachment <> "" Then If Dir(sAttachment, 16) <> "" Then .Attachments.Add sAttachment 'просто вложение 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName End If End If .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub
Название: Re:Сохранить и отправить лист из книги в формате pdf на почту
Отправлено: Дмитрий Щербаков(The_Prist) от 11.06.2021, 14:55:01
Ибрагим, что в последнем сообщении Вы хотели донести? Зачем цитировать свое первое сообщение целиком, да еще без какого-либо смыслового наполнения? По вопросу: запишите макрорекордером сохранения нужного листа в PDF и используйте в коде. Это вроде как не мега сложная задача: sAttachment = "C:\Users\Дмитрий\Desktop\Книга1.pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ sAttachment, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ False останется этот код добавить перед строкой sTo = "AddressTo@mail.ru"
Название: Re:Сохранить и отправить лист из книги в формате pdf на почту
Отправлено: Ибрагим от 11.06.2021, 15:20:02
Извините, последнее сообщение по ошибке отправил. Я сделал вроде как вы сказали, но в итоге макрос отправляет пустое сообщение без вложения Sub Send_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 закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If 'раскомментировать строку, если в Outlook несколько учетных записей и нужно подключиться к конкретной(только если Outlook закрыть) ' [параметры]: Session.Logon "имя профиля","пароль",[показывать окно выбора профиля], [запускать в новой сессии] 'objOutlookApp.Session.Logon "profile","1234",False, True Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'если не получилось создать приложение или экземпляр сообщения - выходим If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub sAttachment = "C:\Users\EXPRESSING\Desktop\На почту\Реестр грузовых авианакладных за период с " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 11, "[$-FC22]DD.MM.YYYY г.") & " по " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 20, "[$-FC22]DD.MM.YYYY " & "г.").pdf ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ sAttachment, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ False sTo = "IbrahimBelkhoroev6@gmail.com" 'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value) sSubject = "" 'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value) sBody = "" 'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value) sAttachment = "C:\Users\EXPRESSING\Desktop\На почту\Реестр грузовых авианакладных за период с " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 11, "[$-FC22]DD.MM.YYYY г.") & " по " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 20, "[$-FC22]DD.MM.YYYY " & "г.").pdf 'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value) 'создаем сообщение With objMail .To = sTo 'адрес получателя .CC = "" 'адрес для копии .BCC = "" 'адрес для скрытой копии .Subject = sSubject 'тема сообщения .Body = sBody 'текст сообщения '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) 'добавляем вложение, если файл по указанному пути существует(dir проверяет это) If sAttachment <> "" Then If Dir(sAttachment, 16) <> "" Then .Attachments.Add sAttachment 'просто вложение 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName End If End If .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub
Название: Re:Сохранить и отправить лист из книги в формате pdf на почту
Отправлено: Дмитрий Щербаков(The_Prist) от 11.06.2021, 16:07:49
Вы сделали не так как я написал. Оставить надо только то, что я показал, а строку sAttachment = "C:\Temp\Книга1.xls" ' удалить вообще. Логику-то включайте. Ну и строка Ваша я не знаю на чем и как основана, но выглядит не соответствующей синтаксису хотя бы потому, что ").pdf" без кавычек. Учите хотя бы азы VBA, должно быть так: sAttachment = "C:\Users\EXPRESSING\Desktop\На почту\Реестр грузовых авианакладных за период с " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 11, "[$-FC22]DD.MM.YYYY г.") & " по " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 20, "[$-FC22]DD.MM.YYYY г.") & ".pdf"
Название: Re:Сохранить и отправить лист из книги в форм
Отправлено: Ибрагим от 12.06.2021, 13:45:28
Этот код работает, вот только мне нужно добавить свои предпочтения, а именно, чтобы вставленный рисунок не выводился при отправке на один адрес почты, а на другой выводился и ещё добавить в письмо подпись, она у меня стоит в самой почте по умолчанию? Sub Send_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 закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If 'раскомментировать строку, если в Outlook несколько учетных записей и нужно подключиться к конкретной(только если Outlook закрыть) ' [параметры]: Session.Logon "имя профиля","пароль",[показывать окно выбора профиля], [запускать в новой сессии] 'objOutlookApp.Session.Logon "profile","1234",False, True Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение 'если не получилось создать приложение или экземпляр сообщения - выходим If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub sAttachment = "C:\Users\EXPRESSING\Desktop\На почту\Реестр грузовых авианакладных за период с " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 11, "[$-FC22]DD.MM.YYYY г.") & " по " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 20, "[$-FC22]DD.MM.YYYY г.") & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ sAttachment, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ False sTo = "IbrahimBelkhoroev6@gmail.com" 'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value) sSubject = "Реестр грузовых авианакладных за период с " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 11, "[$-FC22]DD.MM.YYYY г.") & " по " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 20, "[$-FC22]DD.MM.YYYY г.") & ".pdf" 'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value) sBody = "" 'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value) sAttachment = "C:\Users\EXPRESSING\Desktop\На почту\Реестр грузовых авианакладных за период с " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 11, "[$-FC22]DD.MM.YYYY г.") & " по " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 20, "[$-FC22]DD.MM.YYYY г.") & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ sAttachment, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ False 'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value) 'создаем сообщение With objMail .To = sTo 'адрес получателя .CC = "" 'адрес для копии .BCC = "" 'адрес для скрытой копии .Subject = sSubject 'тема сообщения .body = sBody 'текст сообщения '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) 'добавляем вложение, если файл по указанному пути существует(dir проверяет это) Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName 'добавляем подпись к письму 'создаем новое письмо Set objTmpMail = objOutlookApp.CreateItem(0) 'отображаем его - у него появится подпись objTmpMail.Display 'теперь к нашему текущему(рабочему) письму просто добавляем текст из временного objMail.body = objMail.body & objTmpMail.body 'удаляем временное письмо objTmpMail.Delete If sAttachment <> "" Then If Dir(sAttachment, 16) <> "" Then .Attachments.Add sAttachment 'просто вложение 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName End If End If .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub
Название: Re:Сохранить и отправить лист из книги в формате pdf на почту
Отправлено: Дмитрий Щербаков(The_Prist) от 13.06.2021, 10:32:09
вот только мне нужно ещё добавить И с правилами форума ознакомиться, раз согласились с ними при регистрации. Все Ваши остальные вопросы не имеют прямого отношения к созданной теме. Да и непонятно ни разу, на какой адрес надо, а на какой нет, если у Вас в принципе только один адрес используется в отправке. Да и про какой рисунок речь тоже неясно. добавить в письмо подпись Это все давно есть на сайте: Вставить в письмо подпись из Outlook через VBA (https://www.excel-vba.ru/chto-umeet-excel/vstavit-v-pismo-podpis-iz-outlook-cherez-vba/)
Название: Re:Сохранить и отправить лист из книги в формате pdf на почту
Отправлено: Ибрагим от 14.06.2021, 10:55:04
Я добавил подпись, там оказывается нужно было сначала в Outlook добавить подпись, но сейчас снова столкнулся с проблемой, дело в том, что шрифт подписи не тот, что мне нужен хотя я добавил подпись в Outlook в нужном мне шрифте и картинка в этой подписи не отображается в письме после отправки, там просто название картинки бывает и все, не знаете, как это исправить, может там в коде нужно что-то добавить?
|