I have a macro for Outlook where I can create a complete mail with an attachment but can not add a signature saved in my C drive (C:\Users\JustinG\AppData\Roaming\Microsoft\Signatures).
Signature types are .rtf and .htm with images.
The following is the code:
Sub Mail_Workbook_1()
Dim OutApp As Object
Dim Outmail As Object
Set OutApp = CreateObject("Outlook.Application")
Set Outmail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With Outmail
.SentOnBehalfOfName = "justin.gatlin#rediffmail.com"
.To = "abc#xyz.com"
.CC = ""
.BCC = ""
.Subject = "Presentation"
.Body = "Hi Team,"
.Attachments.add ("C:\Users\DurshetwarA\Desktop\Excel Examination_Master_V1.xlsx")
.display
''SendKeys ("%s")
End With
On Error GoTo 0
Set Outmail = Nothing
Set OutApp = Nothing
End Sub
In the .htm file in the signatures directory you can edit the htm file. The pictures are stored as relative path and when you use the code it looses that path so if you use discrete path it will be able to find the pictures. so go into the file and look for any relative paths and make them discrete.
"/Microsoft/Signatures/picturefile.jpg"
change that to include the whole path
"/root/user/blah blah../Microsoft/Signatures/picturefile.jpg"
This solved the missing image problem for me.
Solution described here by Ron de Bruin.
Sub Mail_Outlook_With_Signature_Html_2()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<H3><B>Dear Customer Ron de Bruin</B></H3>" & _
"Please visit this website to download the new version.<br>" & _
"Let me know if you have problems.<br>" & _
"Ron's Excel Page" & _
"<br><br><B>Thank you</B>"
'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Mysig.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = strbody & "<br>" & Signature
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Instead of .body use .htmlbody and design your message body in HTML. This is the only way of inserting image in your message. There is no specific option to insert signature
Similar to the solution posted by Adavid02, here you may find a more detailed explanation.
Related
I'm using outlook 2016 and Excel 2016. I have written a code to paste a email in the outlook body. My email body contains html codes which has image included,the code works fine however I'm not able to paste the image in the email body. Please help.
Please find the vba code below.
Sub Send_Mails()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim subj As String
Dim recp As String
Dim bccrep As String
Dim ccrecp As String
Dim i As Integer
For i = 2 To 10
Sheets("Email Draft").Select
strbody = Sheets("Email Draft").Range("C1")
subj = "Welcome - " & Sheets("Macro").Range("O" & i)
recp = Sheets("Macro").Range("I" & i)
ccrecp = Sheets("Macro").Range("J" & i)
bccrep = Sheets("Macro").Range("K" & i)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = recp
.CC = ccrecp
.BCC = bccrep
.Subject = subj
.HTMLBody = .HTMLBody & strbody
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
Next i
End Sub
If you appending HTML to the existing HTML message body you are likely adding content outside of the element and it won't be visible. You have to modify what is in the element. As an alternative to manipulating the HTML string, you can use the Word Object Model to change the body content via Inspector.WordEditor.
I have a simple code to open Microsoft Outlook and send an email with an attachment. I would like to send the email securely. Meaning, I would like to know if there is any code that would be tantamount to pressing the "Send Securely" button in outlook. Here is my code so far.....
Sub EmailInvoice()
Dim OutlookApp As Object, OutlookMessage As Object
Dim FileName As String, EmailAddress As String
EmailAddress = Range("ProviderEmail").Value
FileName = "C:\Users\rblahblahblah.txt"
Set OutlookApp = GetObject(class:="Outlook.Application") 'Handles if
Outlook is already open
Err.Clear
If OutlookApp Is Nothing Then Set OutlookApp =
CreateObject(class:="Outlook.Application") 'If not, open Outlook
If Err.Number = 429 Then
MsgBox "Outlook could not be found, aborting.", 16, "Outlook Not Found"
Exit Sub
End If
'Create a new email message
Set OutlookMessage = OutlookApp.CreateItem(0)
'Create Outlook email with attachment
With OutlookMessage
.To = EmailAddress
.CC = ""
.BCC = ""
.Subject = "Invoice for Upload - " & Month
.Body = "Please upload the attached file to the Vendor Portal."
.Attachments.Add FileName
.Display
.Send
End With
End Sub
The code below will send it with a sensitivity enumeration but not securely (Certified Mail). I also add my signature (Default) to the email.
Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2013
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim SigString As String
Dim Signature As String
For Each cell In ThisWorkbook.Sheets("Email List").Range("B1:B100")
If cell.Value Like "?*#?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
strto = strto & cell.Value & ";"
End If
Next cell
If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'Change only Mysig.htm to the name of your signature
SigString = Environ("appdata") & "\Microsoft\Signatures\Default.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
.to = strto
.CC = ""
.BCC = ""
.Subject = ("*Confidential*: Policyholder Name Here - Policy # Here - Premium Bill")
.HTMLBody = "Attached is the most recent premium bill in Excel." & "<br><br>" & Signature
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Importance = 2 '(0=Low, 1=Normal, 2=High)
.Sensitivity = 3 '(0=Normal, 1=Personal, 2=Private, 3=Confidential)
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
I create a new email with the code below.
I'd like to have an attachment. I think I have to use an OutMail.Attachment.Method but the attachment needs to be a specific email.
I want the entire email with contents (ie. texts, files, pics, etc.) as the attachment.
I'd like to attach whatever email I have highlighted (as an .msg).
Public Sub RemarkRequest()
Dim OutApp As Object
Dim OutMail As Object
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
'Get the user signature
With OutMail
.Display
End With
Signature = OutMail.HTMLBody
'Change the mail address and subject in the macro before you run it.
With OutMail
.To = "yyy#bbb.com; zzz#bbb.com"
.CC = ""
.BCC = ""
.Subject = "Subject"
.HTMLBody = "Text" & Signature
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Example will be -
'// Forces explicit declaration of all variables in a file
Option Explicit
Sub ForwardAsAttchment()
'// Declare variables
Dim olMsg As Outlook.MailItem
Dim olItem As Outlook.MailItem
Dim olSignature As String
On Error Resume Next
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No Item selected")
Exit Sub
End If
For Each olItem In Application.ActiveExplorer.Selection
Set olMsg = Application.CreateItem(olMailItem)
'// Get the user signature
With olMsg
.Display
End With
olSignature = olMsg.HTMLBody
'// Change the mail address and subject in the macro before you run it.
With olMsg
.Attachments.Add olItem, olEmbeddeditem ' Attch Selected email
.Subject = "Subject"
.To = "yyy#bbb.com; zzz#bbb.com"
.CC = ""
.BCC = ""
.HTMLBody = "Text" & olSignature
.Display
' .Send
End With
Next
'// Clean up
Set olItem = Nothing
Set olMsg = Nothing
End Sub
I have code to send email. I'm struggling to CC the sender? If I mail I should get the CC, if my colleague mails he should get the CC.
Our usernames aren't firstname.lastname but our email addresses are.
Sub SendPDF()
Dim strPath As String, strFName As String
Dim OutApp As Object, OutMail As Object
Title = Format(Now(), "dd/mm/yyyy") & " - " & ActiveSheet.Name & ""
strPath = Environ$("temp") & "\" 'Or any other path, but include trailing "\"
strFName = ActiveWorkbook.Name
strFName = Format(Now(), "yyyymmdd") & " - " & ActiveSheet.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPath & strFName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "firstname.surname#email.com"
.CC = ""
.BCC = ""
.Subject = Title
.body = "Please see attached"
.Attachments.Add strPath & strFName
'.Display
.Send
End With
Kill strPath & strFName
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
You can use the CurrentUser property of the Namespace class to get the currently logged-on user as a Recipient object. Then you can get the Address property value which representing the e-mail address of the Recipient.
.CC = nameSpace.CurrentUser.Address;
Also you may find the How To: Fill TO,CC and BCC fields in Outlook programmatically article helpful.
Sub email()
Dim a As Integer
Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngCc As Range
Dim rngBcc As Range
Dim rngSubject As Range
Dim rngAttach As Range
Dim rngBody As Range
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With ActiveSheet
Set rngTo = .Range("B1")
Set rngCc = .Range("B2")
Set rngBcc = .Range("B3")
Set rngSubject = .Range("B4")
Set rngAttach = .Range("B5")
Set rngBody = .Range("B6")
End With
With objMail
.To = rngTo.Value
.Cc = rngCc.Value
.Bcc = rngBcc.Value
.Subject = rngSubject.Value
.Attachments.Add rngAttach.Value
.Body = rngBody.Value
.Display
End With
Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngCc = Nothing
Set rngBcc = Nothing
Set rngSubject = Nothing
Set rngAttach = Nothing
Set rngBody = Nothing
End Sub
I know this is kind of old, but I ended up here, so someone else might!
I was able to get the sender CC'd using the namespace (at least in an exchange environment). In my case, the CurrentUser. The address returned a string like the following:
/o=ExchangeLabs/ou=Exchange Administrative Group (XXXXXXXXXXXXXXXX)/cn=Recipients/cn=XXXXXXXXXXXXXXXXXXXXXXXXXXXXX-XXXXXXX
This was resolved successfully, and successfully CC'd the sender.
Might also look at Get sender's email address with Excel VBA
Sub TestCC()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim OutNS As Outlook.Namespace
' Get open Outlook, or create a new instance
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then Set OutApp = CreateObject("Outlook.Application")
On Error GoTo 0
' Get MAPI Namespace
Set OutNS = OutApp.GetNamespace("MAPI")
' Create Mail Item
Set OutMail = OutApp.CreateItem(olMailItem) 'Item type 0
' Build email
On Error Resume Next
With OutMail
.To = "first.last#email.com"
.CC = OutNS.CurrentUser.Address
.BCC = ""
.Subject = "Email Subject Line"
.Body = "Body Text"
' Resolve added recipients
.Recipients.ResolveAll
' Display or Send created email
.Display
'.Send
End With
' Clean up
Set OutMail = Nothing
Set OutNS = Nothing
Set OutApp = Nothing
End Sub
I am writing macro that will set a signature after choosing the From field or for example clicking reply. My problem is that I don't know how to get the From field value. I know how to set this field.
Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Function GetSignature(Mailbox As String) As String
Dim Signature As String
Dim SigStringPL As String
Dim SigStringUK As String
SigStringPL = Environ("appdata") & _
"\Microsoft\Signatures\Poland.htm"
SigStringUK = Environ("appdata") & _
"\Microsoft\Signatures\United Kingdom.htm"
If Mailbox = "poland#poland.pl" Then
If Dir(SigStringPL) <> "" Then
GetSignature = GetBoiler(SigStringPL)
Else
GetSignature = ""
End If
Else
If Dir(SigStringUK) <> "" Then
GetSignature = GetBoiler(SigStringUK)
Else
GetSignature = ""
End If
End If
End Function
Sub Mail_Outlook_With_Signature_Plain()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2010
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "content"
Signature = GetSignature("erni#erni.pl")
MsgBox (OutMail.SentOnBehalfOfName)
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.subject = "This is the Subject line"
.HTMLBody = strbody & "<br><br>" & Signature
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Regards,
erni
SenderName is the field name for 'From' field.
From is SentOnBehalfOfName. In normal use, it is empty until the item has been sent.
Do not choose the From manually.
Sub replySentOnBehalf()
Dim objMsg As mailitem
Set objMsg = ActiveInspector.currentItem.reply
objMsg.SentOnBehalfOfName = "someone#somewhere.com"
' Now that objMsg.SentOnBehalfOfName is available run your code
objMsg.Display
Set objMsg = Nothing
End Sub