Vba вставка подписи в сообщение outlook
Я для более унифицированного подхода, хотел еще один интересный вопрос решить -это вставка подписи в отправляемое письмо. И в принципе даже нашел часть макроса по извлечению подписи из txt файла, но к сожалению мои знания не позволяют интегрировать эту часть макроса с Вашим творением, к тому же в данном макросе у меня не до конца получалось реализовать эту функцию, вместо извлеченной подписи у меня в теле письма прикладывалась информация из первого столбца отправляемого файла.
Не поможете разобраться в этом вопросе, Rioran?
[vba]
Sub Mail_Workbook_1()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
On Error GoTo cleanup
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
.
.
.
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Я для более унифицированного подхода, хотел еще один интересный вопрос решить -это вставка подписи в отправляемое письмо. И в принципе даже нашел часть макроса по извлечению подписи из txt файла, но к сожалению мои знания не позволяют интегрировать эту часть макроса с Вашим творением, к тому же в данном макросе у меня не до конца получалось реализовать эту функцию, вместо извлеченной подписи у меня в теле письма прикладывалась информация из первого столбца отправляемого файла.
Не поможете разобраться в этом вопросе, Rioran?
[vba]
Sub Mail_Workbook_1()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
On Error GoTo cleanup
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
.
.
.
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Sub Mail_Workbook_1()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
On Error GoTo cleanup
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
.
.
.
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Bulava81, есть несколько вариантов:
1). У вас есть стандартная подпись Outlook (или Вы можете её сделать и использовать). Тогда это один код. Нашёл другой, который проще Вашего.
2). Есть вариант прописать подпись в макросе - одна строка, например, имя, вторая - телефон и т.д.
3). И, из разряда извращений - можно подтягивать тексты подписи из Excel файла. Например, если для разных отправителей нужна вариативность подписи.
Что Вам лучше подойдёт? Я бы рекомендовал 1-й вариант.
[offtop]Задавая вопрос, не обязательно обращаться к кому-то персонально - на этом форуме очень много компетентных специалистов [/offtop]
Bulava81, есть несколько вариантов:
1). У вас есть стандартная подпись Outlook (или Вы можете её сделать и использовать). Тогда это один код. Нашёл другой, который проще Вашего.
2). Есть вариант прописать подпись в макросе - одна строка, например, имя, вторая - телефон и т.д.
3). И, из разряда извращений - можно подтягивать тексты подписи из Excel файла. Например, если для разных отправителей нужна вариативность подписи.
Что Вам лучше подойдёт? Я бы рекомендовал 1-й вариант.
[offtop]Задавая вопрос, не обязательно обращаться к кому-то персонально - на этом форуме очень много компетентных специалистов [/offtop] Rioran
1). У вас есть стандартная подпись Outlook (или Вы можете её сделать и использовать). Тогда это один код. Нашёл другой, который проще Вашего.
2). Есть вариант прописать подпись в макросе - одна строка, например, имя, вторая - телефон и т.д.
3). И, из разряда извращений - можно подтягивать тексты подписи из Excel файла. Например, если для разных отправителей нужна вариативность подписи.
Что Вам лучше подойдёт? Я бы рекомендовал 1-й вариант.
[offtop]Задавая вопрос, не обязательно обращаться к кому-то персонально - на этом форуме очень много компетентных специалистов [/offtop] Автор - Rioran
Дата добавления - 23.06.2014 в 15:58
Да у меня есть стандартная подпись в OutLook и в принципе я уже даже в макросе указал путь к ней:)
[vba]
Да у меня есть стандартная подпись в OutLook и в принципе я уже даже в макросе указал путь к ней:)
[vba]
Задавая вопрос, не обязательно обращаться к кому-то персонально - на этом форуме очень много компетентных специалистов :D
Задавая вопрос, не обязательно обращаться к кому-то персонально - на этом форуме очень много компетентных специалистов :D
Задавая вопрос, не обязательно обращаться к кому-то персонально - на этом форуме очень много компетентных специалистов :D
Bulava81, попробуйте.
Возможно, в код достаточно добавить лишь две строки. При этом к тексту письма теперь можно внутри кавычек применять HTML-тэги.
Bulava81, попробуйте.
Возможно, в код достаточно добавить лишь две строки. При этом к тексту письма теперь можно внутри кавычек применять HTML-тэги.
Возможно, в код достаточно добавить лишь две строки. При этом к тексту письма теперь можно внутри кавычек применять HTML-тэги.
Я просто еще раз убеждаюсь, что RIORAN ГЕНИЙ. Так просто и в то же время рационально решить очень интересный и важный вопрос!
Спасибо Вам огромное Роман
Я просто еще раз убеждаюсь, что RIORAN ГЕНИЙ. Так просто и в то же время рационально решить очень интересный и важный вопрос!
Спасибо Вам огромное Роман Bulava81
Коллеги, помогите разобраться с подписью в моём коде:
Есть готовый макрос для отправки письма, со следующей структурой:
1. Текст 1 (приветствие)
2. Вставленный в тело письма фрагмент excel таблицы
3. Текст 2 (к примеру, краткие пояснения к таблице)
А вот четвёртым пунктом - необходимо автоматически подгрузить подпись из Outlook. Причём подгружаться должна та подпись, которая настроена по умолчанию на данном компьютере/OutlookЕ (письмо может быть отправлено не только с моего адреса (компьютера), следовательно подпись должна меняться в зависимости от того, кто пользуется этим макросом)
Помогите, пожалуйста, понять, что нужно добавить в этот код, чтобы заработала подпись, предложенные выше варианты в данном случае увы не работают:
Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Nothing
On Error Resume Next
Set rng = Sheets(1).Range("A1:K4").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbodyb = "ТЕКСТ 1"
Strbodya = "ТЕКСТ 2"
On Error Resume Next
With OutMail
.To = "test@test.ru"
.CC = ""
.BCC = ""
.Subject = "Название письма"
.HTMLBody = strbodyb & RangetoHTML(rng) & Strbodya
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
' Copy the range and create a workbook to receive the data.
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
' Read all data from the .htm file into the RangetoHTML subroutine.
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource align=left x:publishsource text/javascript">$('div.msg_t:last').html($('div.msg_t:last').html().replace(/\[spoiler\]/ig,'
Коллеги, помогите разобраться с подписью в моём коде:
Есть готовый макрос для отправки письма, со следующей структурой:
1. Текст 1 (приветствие)
2. Вставленный в тело письма фрагмент excel таблицы
3. Текст 2 (к примеру, краткие пояснения к таблице)
А вот четвёртым пунктом - необходимо автоматически подгрузить подпись из Outlook. Причём подгружаться должна та подпись, которая настроена по умолчанию на данном компьютере/OutlookЕ (письмо может быть отправлено не только с моего адреса (компьютера), следовательно подпись должна меняться в зависимости от того, кто пользуется этим макросом)
Помогите, пожалуйста, понять, что нужно добавить в этот код, чтобы заработала подпись, предложенные выше варианты в данном случае увы не работают:
Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Nothing
On Error Resume Next
Set rng = Sheets(1).Range("A1:K4").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbodyb = "ТЕКСТ 1"
Strbodya = "ТЕКСТ 2"
On Error Resume Next
With OutMail
.To = "test@test.ru"
.CC = ""
.BCC = ""
.Subject = "Название письма"
.HTMLBody = strbodyb & RangetoHTML(rng) & Strbodya
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
' Copy the range and create a workbook to receive the data.
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
' Read all data from the .htm file into the RangetoHTML subroutine.
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource align=left x:publishsource name">chendex
Есть готовый макрос для отправки письма, со следующей структурой:
1. Текст 1 (приветствие)
2. Вставленный в тело письма фрагмент excel таблицы
3. Текст 2 (к примеру, краткие пояснения к таблице)
А вот четвёртым пунктом - необходимо автоматически подгрузить подпись из Outlook. Причём подгружаться должна та подпись, которая настроена по умолчанию на данном компьютере/OutlookЕ (письмо может быть отправлено не только с моего адреса (компьютера), следовательно подпись должна меняться в зависимости от того, кто пользуется этим макросом)
Помогите, пожалуйста, понять, что нужно добавить в этот код, чтобы заработала подпись, предложенные выше варианты в данном случае увы не работают:
Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set rng = Nothing
On Error Resume Next
Set rng = Sheets(1).Range("A1:K4").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbodyb = "ТЕКСТ 1"
Strbodya = "ТЕКСТ 2"
On Error Resume Next
With OutMail
.To = "test@test.ru"
.CC = ""
.BCC = ""
.Subject = "Название письма"
.HTMLBody = strbodyb & RangetoHTML(rng) & Strbodya
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
' Copy the range and create a workbook to receive the data.
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With
Прежде чем начать читать статью прошу принять к сведению объявление: используйте СВОИ АДРЕСА ЭЛ.ПОЧТЫ при тестировании кодов . Не надо отсылать письма на указанные в статье e-mail адреса- это все приходит мне на почту. Помимо этого Вы сами не сможете понять работает или нет, т.к. письма придут мне, а не Вам.
Спасибо за понимание
P.S. А если написанное выше Вы все же проигнорировали и отправили письмо на мои адреса электронной почты - это означает, что Вы соглашаетесь с тем, что вся информация внутри письма, включая вложения, может быть использована мной без ограничений в личных целях.
Отправка через меню Excel
Отправку без кода осуществить достаточно просто:
Далее выбирается способ отправки:
Sub SendMailStandart() ActiveWorkbook.SendMail "mail1@excel-vba.ru", "Тема письма" End Sub
Также можно указать несколько получателей:
Sub SendMailStandart_MassRecipients() ActiveWorkbook.SendMail Array("mail1@excel-vba.ru", "mail2@excel-vba.ru"), "Тема письма" End Sub
Этот код отправляет одно письмо и одно вложение за раз. Но если несколько раз вызвать метод .Attachments.Add, то можно добавить еще файлы:
.Attachments.Add "C:\Temp\Книга1.xlsx" .Attachments.Add "C:\Temp\Книга2.xlsx" .Attachments.Add "C:\Documents\Report.rar"
objOutlookApp.Session.Logon "user","1234",False, True
имеет особое значение. По сути она нужна только в тех случаях, когда в Outlook настроено несколько профилей(не путать с учетными записями) и запускать нужно от конкретного. Если профиль только один или не указан, то Outlook запускается с профилем по умолчанию. Для этого строку нужно записать без параметров(так же можно записать эту строку, если Outlook при попытке создания письма выдает ошибку профиля):
Этот код отправляет одно письмо и вставляет одну картинку. За это отвечает строка
""
Если картинку надо вложить с заранее указанными размерами, то строка будет выглядеть так:
"" 'height - высота 'width - ширина
Если надо добавить несколько картинок, то метод .Attachments.Add sPicture надо будет вызвать столько раз, сколько картинок(для каждого свой путь к картинке).
Важно помнить: пути для картинок должны содержать полный путь до файла, включая его имя и расширение: C:\Документы\Изображения\Excel_vba_ru.jpg . При указании только имени Excel_vba_ru.jpg или пути без расширения ( C:\Документы\Изображения\Excel_vba_ru ) ошибки не будет, но картинка не будет вставлена, а вместо неё скорее всего будет текст "Ошибка загрузки картинки!" или пустой квадрат вместо реальной картинки.
- Outlook 2007 : Меню-Параметры-Центр управления безопасностью-Программный доступ-установить Никогда не предупреждать о подозрительной активности (не рекомендуется)
- Outlook 2010 и выше : Файл-Параметры-Центр управления безопасностью-Программный доступ-установить Никогда не предупреждать о подозрительной активности (не рекомендуется)
ВАЖНО: Если компьютер управляется администратором Microsoft Exchange или Microsoft Windows Active Directory Domain Services и администратором в качестве параметров по умолчанию установлен запрет на внесение изменений в параметры безопасности пользователями, возможность изменения данных настроек безопасности программного доступа будет недоступна.
Но так же при отправке файлов и писем часто необходимо не привязываться к конкретной почтовой программе. Ведь далеко не все ставят Outlook. Многие используют иные почтовые программы, например TheBat.
Данный код отправляет письмо, используя объект CDO (Collaboration Data Objects - присутствует во всех версиях Windows) и от имени Вашей учетной записи(либо Яндекс, либо Мэйл, либо Рамблер либо др.).
Это основные моменты. Поля Кому(sTo), От кого(sFrom),Тема письма(sSubject), Текст письма(sBody) и Вложение(sAttachment) думаю не нуждаются в расшифровке.
Чтобы использовать данный код вы можете либо просто скопировать его прямо со страницы, либо скачать файл. В файле программа немного упрощена к использованию - в ячейки листа вам необходимо будет внести поля: Кому(sTo), От кого(sFrom),Тема письма(sSubject), Текст письма(sBody) и Вложение(sAttachment) и выбрать SMTPserver. SMTPserver выбирается из выпадающего списка. Сам список является динамическим и расположен на листе "Settinngs". Там же расположены поля Учетной записи и Пароль, которые автоматически подставляются в необходимые поля на листе "Отправка". Т.к. список динамический Вы можете просто добавлять к уже имеющимся новые сервисы и потом просто выбирать их из списка. Так же в файле есть еще одна возможность - выбрать файл. Для этого надо просто нажать на кнопку и выбрать файл.
With oCDOMsg Set .Configuration = oCDOCnf .From = sFrom .BodyPart.Charset = "windows-1251" .To = sTo .Subject = sSubject Set objbp = oCDOMsg.AddRelatedBodyPart("C:\Документы\Изображения\11.jpg", "11.jpg", 1) objbp.Fields.Item("urn:schemas:mailheader:Content-ID") = "" objbp.Fields.Update If Len(sAttachment) > 0 Then If Dir(sAttachment, 16) <> "" Then .AddAttachment sAttachment End If End If 'для вложения картинки письмо лучше формировать в формате HTML .HTMLBody = "
" & sBody .Send End With
Самый главный момент:
AddRelatedBodyPart
-
C:\Документы\Изображения\11.jpg - указывается полный путь к файлу картинки на компьютере, включая расширение файла.
11.jpg - указывается имя картинки с расширением. Это имя будет использовано внутри письма и именно его необходимо будет указать дальше в " urn:schemas:mailheader:Content-ID ". И указывать обязательно в треугольных скобках: " "
внутри же самого письма в том месте, где должна отображаться картинки надо записать:
в приведенном выше коде картинка вставляется в самом начале письма и после неё так же добавляется перенос на новую строку при помощи тэга
I am writing a VBA script in Access that creates and auto-populates a few dozen emails. It's been smooth coding so far, but I'm new to Outlook. After creating the mailitem object, how do I add the default signature to the email?
This would be the default signature that is automatically added when creating a new email.
Ideally, I'd like to just use ObjMail.GetDefaultSignature , but I can't find anything like it.
Currently, I'm using the function below (found elsewhere on the internet) and referencing the exact path & filename of the htm file. But this will be used by several people and they may have a different name for their default htm signature file. So this works, but it's not ideal:
(Called with getboiler(SigString = "C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures\Mysig.txt") )
Thanks to JP (see comments), I realize that the default signature is showing up at first, but it disappears when I use HTMLBody to add a table to the email. So I guess my question is now: How do I display the default signature and still display an html table?
Do you have a default signature for new messages? I do, so when I create a message programmatically it is automatically populated with the default signature.
@JP, Yes I have a signature and it is set as the default signature for new messages in the Tools menu. Except it isn't populating the mail object when I create it by automation. If you can tell me how, I'm listening.
I tested this using Outlook.CreateItem(olMailItem).Display in the Immediate Window. With a default signature, the message appears with the signature already there. Can you try the same test?
14 Answers 14
The code below will create an outlook message & keep the auto signature
This is pretty much what I went with. The only difference is that since my email body is html, I used .HTMLbody , not .body . Simple and direct.
Thanks, this worked for what I was interested in too! To any future users, make sure if you want the .HTMLbody to change it in both locations.
Thanks - I'm trying to count the number of default signature files.. so this works. .Display followed by .Count and .Close gets me what i want, but is there any way to Display hidden?
if you want to use .HTMLbody this is not a propper solution breause it creates invalid HTML. The signature (OMail.body) contains a string starting with so you cannot just prepend your text
@Stefan - just tagging you for reference clarity; I imagine you personally know this: If you need to get rid of the tags on the signature so you can easily add it into a .HTMLbody simply replace the signature setting line with signature = Mid(OMail.body,6,Len(OMail.Body)-13) .
My solution is to display an empty message first (with default signature!) and insert the intended strHTMLBody into the existing HTMLBody .
If, like PowerUser states, the signature is wiped out while editing HTMLBody you might consider storing the contents of ObjMail.HTMLBody into variable strTemp immediately after ObjMail.Display and add strTemp afterwards but that should not be necessary.
You don't need to display the message - simply accessing MailItem.GetInspector on a new message will insert the signature. Once you have the signature, you should not concatenate 2 HTML strings - they must be merged: the simplest way is to insert your HTML after the first occurrence of ">" that follows "
@DmitryStreblechenko, I'm trying the Objmail.GetInspecter.Activate and it looks like it does the same thing as Objmail.Display , Either way, it displays the email (which is fine with me since there isn't alot to create)
I appreciate that this answer (unlike the accepted one) was courteous enough to add a sentence on the strategy the code uses, instead of just throwing a block of code at you with no explanation at all. Granted, this is a basic example. But a single sentence is all it took. And describing the strategy before delving into code is just good communication and good manners.
@PowerUser, if you create an Inspector object Dim ObjInspector As Outlook.Inspector , you can access MailItem.GetInspector without activating it: Set ObjInspector = ObjMail.GetInspector . I think this is what @DmitryStreblechenko is recommending. This prevents the email from displaying.
Just thought I'd share how I achieve this. Not too sure if it's correct in the defining variables sense but it's small and easy to read which is what I like.
I attach WMBody to .HTMLBody within the object Outlook.Application OLE.
Hope it helps someone.
I figured out a way, but it may be too sloppy for most. I've got a simple Db and I want it to be able to generate emails for me, so here's the down and dirty solution I used:
I found that the beginning of the body text is the only place I see the " " in the HTMLBody of a new email, so I just did a simple replace, replacing
where sBody is the body content I want inserted. Seems to work so far.
This worked EXCELLENTLY for me! Far from quick and dirty, this was the most elegant answer of all. As noted earlier, just remember to call .display before you call the function shown above, otherwise there's no signature inserted yet.
I constructed this approach while looking for how to send a message on a recurring schedule. I found the approach where you reference the Inspector property of the created message did not add the signature I wanted (I have more than one account set up in Outlook, with separate signatures.)
The approach below is fairly flexible and still simple.
I have made this a Community Wiki answer because I could not have created it without PowerUser's research and the help in earlier comments.
I took PowerUser's Sub X and added
after every statement. From this I discovered the signature is not within .HTMLBody until after ObjMail.Display and then only if I haven't added anything to the body.
I went back to PowerUser's earlier solution that used C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures\Mysig.txt") . PowerUser was unhappy with this because he wanted his solution to work for others who would have different signatures.
My signature is in the same folder and I cannot find any option to change this folder. I have only one signature so by reading the only HTM file in this folder, I obtained my only/default signature.
I created an HTML table and inserted it into the signature immediately following the element and set the html body to the result. I sent the email to myself and the result was perfectly acceptable providing you like my formatting which I included to check that I could.
My modified subroutine is:
Since both PowerUser and I have found our signatures in C:\Users\" & Environ("username") & "\AppData\Roaming\Microsoft\Signatures I suggest this is the standard location for any Outlook installation. Can this default be changed? I cannot find anything to suggest it can. The above code clearly needs some development but it does achieve PowerUser's objective of creating an email body containing an HTML table above a signature.
I'm glad you found my post useful, but I'm looking for something more direct. A coworker pointed out that a user can insert the default signature manually by using the commandbar Insert->Signatures->(first signature). How can I do this in code? I'm experimenting with Controls and Commandbars, but not making much progress.
I am not sure what you mean by "more direct". This code creates a table over a signature which is what you wanted. I agree its only a dummy table but I do not know where the actual table is to come from.
I need 50 rep to post a comment against the Signature Option I found most helpful, however I had an issue with images not showing correctly so I had to find a work around. This is my solution:
Notes:
Back up your .htm file before starting, copy & paste to a secondary folder
You will be working with both the SignatureName.htm and the SignatureName_files Folder
You do not need HTML experience, the files will open in an editing program such as Notepad or Notepad++ or your specified HTML Program
Navigate to your Signature File location (standard should be C:\Users\"username"\AppData\Roaming\Microsoft\Signatures )
Open the SignatureName.htm file in a text/htm editor (right click on the file, "Edit with Program")
Use Ctrl+F and enter .jpg ; .jpg or if you don't know your image type, use image001 You will see something like: src="https://stackoverflow.com/questions/8994116/signaturename_files/image001.jpg"
You need to change that to the whole address of the image location C:\Users\YourName\AppData\Roaming\Microsoft\Signatures\SignatureNameFolder_files\image001
or
src="E:\location\Signatures\SignatureNameFolder_files\image001.jpg"
Save your file (overwrite it, you had of course backed up the original)
Return to Outlook and Open New Mail Item, add your signature. I received a warning that the files had been changed, I clicked ok, I needed to do this twice, then once in the "Edit Signatures Menu".
Some of the files in this webpage aren't in the expected location. Do you want to download them anyway? If you're sure the Web page is from a trusted source, click Yes."
Run your Macro event, the images should now be showing.
So, your suggestion is how to add images to a signature. Interesting. When I posted the question originally, I was only thinking about text signatures. But this could be useful in other ways. Thanks.
@PowerUser thanks for commenting. Unless you know HTML code it's best if you insert the images whilst creating the signature in OL. Some of my sigs have them, some don't. My non-default sig does have the images which is why I was hunting for a solution. :) Your Question is the most used and directed to for people wanting to add signatures using VBA. I thought it may indeed be useful for some. :) I hope it helps others that come looking. Have a great day!
Most of the other answers are simply concatenating their HTML body with the HTML signature. However, this does not work with images, and it turns out there is a more "standard" way of doing this.1
Microsoft Outlook pre-2007 which is configured with WordEditor as its editor, and Microsoft Outlook 2007 and beyond, use a slightly cut-down version of the Word Editor to edit emails. This means we can use the Microsoft Word Document Object Model to make changes to the email.
I like Mozzi's answer but found that it did not retain the default fonts that are user specific. The text all appeared in a system font as normal text. The code below retains the user's favourite fonts, while making it only a little longer. It is based on Mozzi's approach, uses a regular expression to replace the default body text and places the user's chosen Body text where it belongs by using GetInspector.WordEditor. I found that the call to GetInspector did not populate the HTMLbody as dimitry streblechenko says above in this thread, at least, not in Office 2010, so the object is still displayed in my code. In passing, please note that it is important that the MailItem is created as an Object, not as a straightforward MailItem - see here for more. (Oh, and sorry to those of different tastes, but I prefer longer descriptive variable names so that I can find routines!)
The existing answers had a few problems for me:
- I needed to insert text (e.g. 'Good Day John Doe') with html formatting where you would normally type your message.
- At least on my machine, Outlook adds 2 blank lines above the signature where you should start typing. These should obviously be removed (replaced with custom HTML).
The code below does the job. Please note the following:
- The 'From' parameter allows you to choose the account (since there could be different default signatures for different email accounts)
- The 'Recipients' parameter expects an array of emails, and it will 'Resolve' the added email (i.e. find it in contacts, as if you had typed it in the 'To' box)
- Late binding is used, so no references are required
Often this question is asked in the context of Ron de Bruin's RangeToHTML function, which creates an HTML PublishObject from an Excel.Range , extracts that via FSO, and inserts the resulting stream HTML in to the email's HTMLBody . In doing so, this removes the default signature (the RangeToHTML function has a helper function GetBoiler which attempts to insert the default signature).
It will raise a runtime 6158:
But we can still leverage the Word.Document which is accessible via the MailItem.GetInspector method, we can do something like this to copy & paste the selection from Excel to the Outlook email body, preserving your default signature (if there is one).
Note that in some cases this may not perfectly preserve the column widths or in some instances the row heights, and while it will also copy shapes and other objects in the Excel range, this may also cause some funky alignment issues, but for simple tables and Excel ranges, it is very good:
Need to add a reference to Microsoft.Outlook. it is in Project references, from the visual basic window top menu.
When I add .Body = "x" the signature stops inserting and all the body has is mytextx. How do I add a body and keep the signature?
@PowerUser, the signature is inserted by default as the initial value. You can save it and add text before it. There are 3 editors. .Body contains plain text. .HTMLBody is html body, basically word converted to html. And there is .GetInspector.WordEditor which is the original word editor. Each editor is used by its way. If you replace the editor value the signature is replaced
Assuming that your signature has this line "Thank you." Now all you need to do is to replace "Thank you." with whatever you want. Note: This is case sensitive so you must use the exact case. "Thank you" is not as "Thank You"
Here's the full code:
It's a solid idea for most text snippets but it wouldn't connect to Outlooks' default signature, only a text string embedded in the VBA.It would work, but would mean regular updates to the VBA code whenever Marketing changes our email signatures.
You're right but the aim was to be super simple, especially if you have control over the signature. If you want it to be really error proof under any circumstances then you'll have to put a lot of code unfortunately. Perhaps it could me modified to read the first line of the signature then do the replace. In that case it should work always.
Outlook adds the signature to the new unmodified messages (you should not modify the body prior to that) when you call MailItem.Display (which causes the message to be displayed on the screen) or when you access the MailItem.GetInspector property (in the older versions of Outlook prior to 2016) - you do not have to do anything with the returned Inspector object, but Outlook will populate the message body with the signature.
Once the signature is added, read the HTMLBody property and merge it with the HTML string that you are trying to set. Note that you cannot simply concatenate 2 HTML strings - the strings need to be merged. E.g. if you want to insert your string at the top of the HTML body, look for the "" (this takes care of the element with attributes), then insert your HTML string after that ">".
Outlook Object Model does not expose signatures at all.
On a general note, the name of the signature is stored in the account profile data accessible through the IOlkAccountManager Extended MAPI interface. Since that interface is Extended MAPI, it can only be accessed using C++ or Delphi. You can see the interface and its data in OutlookSpy (I am its author) if you click the IOlkAccountManager button.
Once you have the signature name, you can read the HTML file from the file system (keep in mind that the folder name (Signatures in English) is localized.
Also keep in mind that if the signature contains images, they must also be added to the message as attachments and the tags in the signature/message body adjusted to point the src attribute to the attachments rather than a subfolder of the Signatures folder where the images are stored.
It will also be your responsibility to merge the HTML styles from the signature HTML file with the styles of the message itself.
If using Redemption (I am its author) is an option, you can use its RDOAccount object - it exposes ReplySignature and NewMessageSignature properties.
Redemption also exposes RDOSignature. ApplyTo method that takes a pointer to the RDOMail object and inserts the signature at the specified location correctly merging the images and the styles:
Я добавил этот умный скрипт в Outlook 2013, и он правильно идентифицирует и выбирает различные подписи электронной почты, которые я использую.
У меня проблема с одним из рисунков, который является частью одной подписи. Вместо отображаемой графики папка «Отправленные» (и получатель) показывает электронное письмо с прикрепленным снимком экрана, и попытка загрузить изображение не работает.
Если я отключу сценарий и подпишусь вручную, исходящая электронная почта будет правильной, и получатель получит то, что я намеревался. Еще более интересно то, что с другой более простой подписью, где изображение представляет собой просто прямую линию, оно включено, хотя изображение немного изменено.
Графика представляет собой файл PNG размером 80 КБ 5904 x 1024 пикселей с глубиной цвета 32, и я пробовал меньшие размеры до 10 КБ 369 x 64 пикселей, но это не помогло. Моя версия Outlook — 15.0.5189.1000 32Bit Professional Plus 2013 на платформе Windows 10 Pro.
Интересно, можете ли вы предложить решение для этого, пожалуйста.
Очень хороший скрипт, но файлы изображений в моей подписи не доставляются правильно. Можете ли вы решить эту проблему?
Привет Висах,
Код был обновлен, и теперь проблема с изображениями исправлена. Приносим извинения за доставленные неудобства.
что вы изменили, чтобы решить проблему с изображениями? Я использую ваш последний код, и у меня та же проблема, что и у Аманды.
Спасибо
Здравствуйте,
Извините за ошибку. VBA был снова обновлен, и проблема с изображениями теперь полностью устранена.
Помимо кода, операция шага 7 также изменилась. Пожалуйста, следуйте инструкциям шаг за шагом, чтобы получить его вниз.
Привет, я хотел бы применить это, чтобы различать подписи при отправке внутренних и внешних электронных писем. Поэтому вместо того, чтобы распознавать конкретные адреса электронной почты, мне нужно было бы просто различать адрес электронной почты получателя, содержащий название моей фирмы внутри него или нет. Не могли бы вы сообщить мне, как будет выглядеть код для этого конкретного случая?
Привет Паули,
Пожалуйста, попробуйте приведенный ниже код. Перед применением кода перейдите на Рекомендации диалоговое окно для проверки Библиотека объектов Microsoft Word коробка (как показано на прикрепленном изображении).
Private Sub Application_ItemSend (ByVal Item As Object, Cancel As Boolean)
'Обновлено ExtendOffice 2020/6/12
Dim xMailItem как MailItem
Dim xRecipients как получатели
Dim xRecipient как получатель
Dim xRcpAddress как строка
Dim xSignatureFile, xSignaturePath как строка
Dim xFSO как Scripting.FileSystemObject
Dim xDoc как документ
On Error Resume Next
Установите xFSO = New Scripting.FileSystemObject
Если Item.Class <> olMail, то выйдите из Sub
Установить xMailItem = элемент
Установите xRecipients = xMailItem.Recipients
xSignaturePath = CreateObject("WScript.Shell").SpecialFolders(5) + "\Microsoft\Signatures\"
Для каждого xRecipient в xRecipients
Если xRecipient.AddressEntry.AddressEntryUserType = olExchangeUserAddressEntry Тогда
Если VBA.InStr(VBA.LCase(xRcpAddress), "@микрософт") > 0 Затем 'Введите строку в двойных кавычках. Если адрес электронной почты получателя содержит эту строку, электронной почте будет присвоена приведенная ниже подпись "internal.htm". В противном случае назначьте подпись "external.htm".
xSignatureFile = xSignaturePath & "в нашей внутренней среде, .htm"
xSignatureFile = xSignaturePath & "и, что лучший способ .htm"
Установить xDoc = xMailItem.GetInspector.WordEditor
xDoc.Application.Selection.MoveDown Unit:=wdLine, Count:=1
xDoc.Application.Selection.InsertFile FileName:=xSignatureFile, Link:=False, Attachment:=False
Привет, Кристал, У меня есть вопрос. Когда я отправляю электронные письма как внешним, так и внутренним получателям, как я могу различать их, выбирая всегда внешнюю подпись? Спасибо
Возможно, вы уже нашли решение для себя или давно забросили эту ветку, но я чувствую побуждение закончить ее сейчас. Простой ответ на этот вопрос:
Измените предложение If-Else (которое различает две подписи) следующим образом:
Если VBA.InStr(VBA.LCase(xRcpAddress), "@microsoft") = 0, то "Введите строку в двойных кавычках. Если адрес электронной почты получателя содержит эту строку, приведенная ниже подпись «internal.htm» будет назначена электронной почте. В противном случае назначьте подпись «external.htm».
xSignatureFile = xSignaturePath & "external.htm"
Выход для
Еще
xSignatureFile = xSignaturePath & "internal.htm"
End If
Что происходит сейчас:
Если адрес получателя из списка адресов получателей НЕ содержит заданной строки, используйте внешнюю подпись и перестаньте искать других получателей. В противном случае используйте внутреннюю подпись и ищите следующий адрес получателя.
У меня какое-то странное поведение с электронными письмами Outlook, созданными VBA. Подпись добавляется в письмо, как и предполагалось, но располагается не внизу письма, а посередине (похоже на первое пустое место). Любая идея, почему и как это преодолеть?
Тим, у меня такая же проблема. Там, где пользователь щелкает последним, вставляется изображение. У кого-нибудь есть способ заставить изображение чуть выше подписи?
Здравствуй, Кристалл,
Меня интересует код VBA, который вы написали для «pauli» ниже, но когда я его запускаю, возникает следующая ошибка (и строка кода «XDoc as Document» выделена):
"Ошибка компиляции: определяемый пользователем тип не определен"
Как я могу решить эту проблему, пожалуйста?
Меня интересует код VBA, который вы написали для «pauli» ниже, но когда я его запускаю, возникает следующая ошибка (и выделена строка кода «XDoc as Document»):
"Ошибка компиляции: определяемый пользователем тип не определен"
Как я могу решить эту проблему, пожалуйста?
Привет Тим, Перед применением кода перейдите в диалоговое окно «Ссылки», чтобы проверить Библиотека объектов Microsoft Word коробка (как показано на прикрепленном изображении).
Есть готовый макрос для отправки письма.
Необходимо автоматически подгрузить подпись из Outlook. Причём подгружаться должна та подпись, которая настроена по умолчанию на данном компьютере/OutlookЕ (письмо может быть отправлено не только с моего адреса (компьютера), следовательно подпись должна меняться в зависимости от того, кто пользуется этим макросом)
Помогите, пожалуйста, понять, что нужно добавить в мой макрос, чтобы заработала подпись.
Нашла макрос с добавлением подписи в письмо, но не знаю как и что добавить из него в мой макрос, чтобы добавлялась подпись.
Мой Макрос для отправки письма:
[vba]
Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Nothing
Set rng = ActiveSheet.Range(Cells(1, 1), Cells(iLastRow, 7))
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Range("'Списки'!L6").Value
.BCC = Range("'Списки'!L9").Value
.CC = Range("'Списки'!L10").Value
.Subject = Range("'Списки'!$J$2").Value
.Attachments.Add Range("'Списки'!L2").Value
.Attachments.Add Range("'Списки'!L3").Value
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
On Error GoTo 0
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource align=left x:publishsource bbCodeBlock">
Dim OutApp As Object, OutMail As Object, Strbody As String, r As Date
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon: Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
r = Format(Now(), "dd mmmm yyyy") 'формат даты
With OutMail
.To = "primer@mail.ru": .CC = "": .BCC = "": .Subject = "Тема " & r & " продолжение темы": 'вставка даты
.Attachments.Add ("C:\Test.xls")
.Body = Activedocument.Content 'в этом случае открывается письмо с подписью той которая по умолчанию в Outlooke
.Display 'or use .send
End With
On Error GoTo 0: Set OutMail = Nothing: Set OutApp = Nothing
End Sub
Есть готовый макрос для отправки письма.
Необходимо автоматически подгрузить подпись из Outlook. Причём подгружаться должна та подпись, которая настроена по умолчанию на данном компьютере/OutlookЕ (письмо может быть отправлено не только с моего адреса (компьютера), следовательно подпись должна меняться в зависимости от того, кто пользуется этим макросом)
Помогите, пожалуйста, понять, что нужно добавить в мой макрос, чтобы заработала подпись.
Нашла макрос с добавлением подписи в письмо, но не знаю как и что добавить из него в мой макрос, чтобы добавлялась подпись.
Мой Макрос для отправки письма:
[vba]
Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Nothing
Set rng = ActiveSheet.Range(Cells(1, 1), Cells(iLastRow, 7))
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Range("'Списки'!L6").Value
.BCC = Range("'Списки'!L9").Value
.CC = Range("'Списки'!L10").Value
.Subject = Range("'Списки'!$J$2").Value
.Attachments.Add Range("'Списки'!L2").Value
.Attachments.Add Range("'Списки'!L3").Value
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
On Error GoTo 0
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource align=left x:publishsource bbCodeBlock">
Dim OutApp As Object, OutMail As Object, Strbody As String, r As Date
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon: Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
r = Format(Now(), "dd mmmm yyyy") 'формат даты
With OutMail
.To = "primer@mail.ru": .CC = "": .BCC = "": .Subject = "Тема " & r & " продолжение темы": 'вставка даты
.Attachments.Add ("C:\Test.xls")
.Body = Activedocument.Content 'в этом случае открывается письмо с подписью той которая по умолчанию в Outlooke
.Display 'or use .send
End With
On Error GoTo 0: Set OutMail = Nothing: Set OutApp = Nothing
End Sub
Есть готовый макрос для отправки письма.
Необходимо автоматически подгрузить подпись из Outlook. Причём подгружаться должна та подпись, которая настроена по умолчанию на данном компьютере/OutlookЕ (письмо может быть отправлено не только с моего адреса (компьютера), следовательно подпись должна меняться в зависимости от того, кто пользуется этим макросом)
Помогите, пожалуйста, понять, что нужно добавить в мой макрос, чтобы заработала подпись.
Нашла макрос с добавлением подписи в письмо, но не знаю как и что добавить из него в мой макрос, чтобы добавлялась подпись.
Мой Макрос для отправки письма:
[vba]
Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Nothing
Set rng = ActiveSheet.Range(Cells(1, 1), Cells(iLastRow, 7))
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Range("'Списки'!L6").Value
.BCC = Range("'Списки'!L9").Value
.CC = Range("'Списки'!L10").Value
.Subject = Range("'Списки'!$J$2").Value
.Attachments.Add Range("'Списки'!L2").Value
.Attachments.Add Range("'Списки'!L3").Value
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
On Error GoTo 0
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource align=left x:publishsource bbCodeBlock">
Dim OutApp As Object, OutMail As Object, Strbody As String, r As Date
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon: Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
r = Format(Now(), "dd mmmm yyyy") 'формат даты
With OutMail
.To = "primer@mail.ru": .CC = "": .BCC = "": .Subject = "Тема " & r & " продолжение темы": 'вставка даты
.Attachments.Add ("C:\Test.xls")
.Body = Activedocument.Content 'в этом случае открывается письмо с подписью той которая по умолчанию в Outlooke
.Display 'or use .send
End With
On Error GoTo 0: Set OutMail = Nothing: Set OutApp = Nothing
End Sub
Читайте также: