I am trying to send an email through vba in excel, all works fine excpect the email attachement. It doesnt seem to link it. Where could be the issue ?
The string attach is pointing to the right file.
Dim OutApp As Object
Dim OutMail As Object
Dim email
Dim attach
email = writeEmailAddress()
attach = attachement()
Sheets("Mail").Range("B1") = email
Sheets("Mail").Range("B2") = "xxxxxx"
Sheets("Mail").Range("B3") = "xxxxxxx"
Sheets("Mail").Range("B4") = attach
MsgBox attach
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.SendKeys "^{ENTER}"
.to = "xxxxx"
.CC = ""
.BCC = ""
.Subject = Sheets("Mail").Range("B5").Value
.Body = Sheets("Mail").Range("B6").Value
'You can add other files also like this
.Attachments.Add attach ' <--------------------------------This is causing troubble
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Change,
.Attachments.Add attach
... to,
If CBool(Len(Dir(attach, vbNormal))) Then
.Attachments.Add attach, 1 '<~~ 1 is olByValue
Else
Debug.Print "Cannot find '" & attach & "'"
End If
If the attachment is not added to your email item, check the VBE's Immediate Window (e.g. Ctrl+G) for the error message.
Related
I want my email template to prompt me for input, and replace specified fields with my input.
For example my email will be like:
Hello [name]
I want a box to pop up where I can enter the name and have it appear throughout the email, replacing [name].
Using my example, by saving "#0#" in your template in the "to:" section of the email, by clicking this template it will prompt you to change that entry with the "Email Address" question.
Sub CommandButton1_Click()
Call OpenTemplate
End Sub
Sub OpenTemplate()
Dim OutMail As Outlook.MailItem
Set OutMail = Application.CreateItemFromTemplate("Template Location")
On Error Resume Next
With OutMail
.To = Replace(.To, "#0#", InputBox("Email Address"))
.CC = ""
.BCC = ""
.Subject = Replace(.Subject, "#1#", InputBox("Prompt 1"))
.Body = Replace(.Body, "#2#", InputBox("Prompt 2"))
.Body = Replace(.Body, "#3#", InputBox("Prompt 3"))
.Body = Replace(.Body, "#4#", InputBox("Prompt 4"))
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I am trying to embed a range from a worksheet as an image in outlook mail body. It's saving the picture correctly but I only see blank image in the outlook mail body. What am I doing wrong here?
Sub View_Email()
tName = Trim(MAIN.Range("tEmail"))
If Not tName Like "*#*.*" Then MsgBox "Invalid Email address": Exit Sub
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'File path/name of the gif file
Fname = ThisWorkbook.Path & "\Claims.jpg"
Set oCht = Charts.Add
STAT.Range("A3:G26").CopyPicture xlScreen, xlBitmap
With oCht
.Paste
.Export Filename:=Fname, Filtername:="JPG"
'.Delete
End With
On Error Resume Next
With OutMail
.To = tName
.CC = ""
.BCC = ""
.Subject = STAT.Range("C1").Value
.HTMLBody = "<html><p>Summary of Claim Status.</p>" & _
"<img src=" & Fname & "' height=520 width=750>"
.display
'.Send 'or use .Display
End With
On Error GoTo 0
'Delete the gif file
'Kill Fname
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
You need to add the image and hide it. The position 0 will add and hide it.
.Attachments.Add Fname, 1, 0
The 1 is the Outlook Constant olByValue
Once you add the image then you have to use "cid:FILENAME.jpg" as shown below.
Try this
With OutMail
.To = tName
.CC = ""
.BCC = ""
.Subject = STAT.Range("C1").Value
.Attachments.Add Fname, 1, 0
.HTMLBody = "<html><p>Summary of Claim Status.</p>" & _
"<img src=""cid:Claims.jpg""height=520 width=750>"
.Display
End With
Screenshot
You need to set the PR_ATTACH_CONTENT_ID MAPI property (DASL name "http://schemas.microsoft.com/mapi/proptag/0x3712001F") using Attachment.PropertyAccessor.SetProperty and refer that attachment through the src attribute that matches the value of PR_ATTACH_CONTENT_ID set on the attachment. PR_ATTACH_CONTENT_ID corresponds to the Content-ID MIME header when the message is sent.
attachment = MailItem.Attachments.Add("c:\temp\MyPicture.jpg")
attachment.PropertyAccessor.SetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F", "MyId1")
MailItem.HTMLBody = "<html><body>Test image <img src=""cid:MyId1""></body></html>"
Keep in mind that setting content-id is preferable to using the attachment file name in the <img> element since it would need to be properly encoded and (if I remember correctly) some e-mail clients have a problem with just using the attachment file name for images.
I have the following code which lets me prepare an email which is ready to be sent:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = ThisWorkbook.Sheets("Users").Range("A1").Value
.CC = ""
.BCC = ""
.Importance = 2
.Subject = "[ACTION REQUIRED] Format(Date, "YYYYMMDD")"
.HTMLBody = "some_body"
.Display
End With
and here is the Users table:
Users Johnson, Jerry Mullen, Carl Mullen, Carl Mullen, Carl Terry, Mark Carlos, Juan
I need to create a macro which lets me prepare an email but my main problem is I don't know how to add recipients using data from Users table.
My current code is not allowing me to attach anything aside from string values (typed directly, or maybe I'm doing something wrong).
I also need it to not attach names that are duplicated.
The following code assumes that you have your users' names in your outlook contact list, and that they are located in the cells A2 and down, but that range can be altered.
Sub test()
Dim users As New Collection
Dim usrRng As Range
Dim recipients As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set usrRng = Range("A2", Range("A2").End(xlDown))
Application.ScreenUpdating = False
On Error Resume Next
For Each cell In usrRng
users.Add cell.Value, cell.Value
Next cell
On Error GoTo 0
For Each usrName In users
recipients = recipients & usrName & "; "
Next usrName
With OutMail
.To = recipients
.CC = ""
.BCC = ""
.Importance = 2
.Subject = "[ACTION REQUIRED] " & Format(Date, "YYYYMMDD")
.HTMLBody = "some_body"
.Display
End With
Application.ScreenUpdating = True
End Sub
What this does, is that it takes each name in the range A2 and down, and adds it to a collection, skipping the duplicates.
Then we make a string, which will be made out of each name we just added to the collection, seperating each name with a ";".
Then we pass that new string to the OutMail object as the receiver of the message.
When the new mail is displayed, the names will not be recognized, but if press send, the mail should be sent to the correct people, assuming you don't have multiple contacts with the same name.
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 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.