The below code embeds the photo but doesn't display because
"The file may have been moved, renamed, or deleted. Verify that the link points to the correct file and location."
I know the file path is correct.
Sub mail()
Dim Sig As String
Set myOlApp = CreateObject("Outlook.Application")
LR400 = Columns(1).Find("*", SearchDirection:=xlPrevious).Row
sPath = Environ("appdata") & "\Microsoft\Signatures\Amir Higgs.txt"
For x = 2 To LR400
If Cells(x, 2) <> "no email" Then
emails = Cells(x, 1)
'TheBody1 = "The Parallon Workforce Team" & vbCrLf & vbCrLf & vbCrLf & _
"Amir Higgs" & vbCrLf & _
"Accounts Payable Clerk" & vbCrLf & _
"Parallon Workforce Solutions" & vbCrLf & _
"1000 Sawgrass Corporate Pkwy, 6th Floor" & vbCrLf & _
"Sunrise, FL 33323" & vbCrLf & _
"P: 954-514-1656" & vbCrLf & _
"www.parallon.com"
Set myitem = myOlApp.CreateItem(olMailItem)
With myitem
.SentOnBehalfOfName = "PARA.WFAdjustments#Parallon.com"
.To = Cells(x, 2)
.Subject = Cells(x, 3)
.Body = TheBody1
'.CC = ""
.Attachments.Add emails
.Attachments.Add "C:\Users\JoeSchmo\Pictures\WF Communications.jpg", olByValue, 0
.HTMLBody = "<BODY><IMG src=""cid:WF Communications.jpg"" width=200> </BODY>"
.display
End With
End If
Next x
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Change your JPG file name to one word Example WF_Communications.jpg or WFCommunications.jpg
.Attachments.Add "C:\Users\JoeSchmo\Pictures\WF_Communications.jpg", olByValue, 0
.HTMLBody = "<BODY><IMG src=""cid:WF_Communications.jpg"" width=200> </BODY>"
Related
This question already has answers here:
Embed picture in outlook mail body excel vba
(2 answers)
Closed 1 year ago.
The below code with .PNG file referenced, works for me. However, while the .PNG gets inserted in the email, it's not actually embedded. As a result, when the recipient receives the email, the image is not displayed.
Sub Mail_workbook_Outlook_1()
relativepath1 = ThisWorkbook.Path & Application.PathSeparator & "Signature99" & ".png"
'Create a new email message
Set OutlookMessage = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMessage
.To = Prime_Email
.cc = cc1
.BCC = ""
.Subject = "Volume - " & " " & str2 & "(" & Subject & ")"
.HTMLBody = RangetoHTML(Range("E2:N16")) & "<img src ='" & relativepath1 & "'>"
.send
'.Display
End With
On Error GoTo 0
Set OutlookMessage = Nothing
Set OutlookApp = Nothing
End Sub
First attach the image to your email, and then embed it within your email...
Sub Mail_workbook_Outlook_1()
Dim relativepath1 As String
relativepath1 = ThisWorkbook.Path & Application.PathSeparator
Dim filename As String
filename = "Signature99.png"
'Create a new email message
Set OutlookMessage = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMessage
.To = Prime_Email
.CC = cc1
.BCC = ""
.Subject = "Volume - " & " " & str2 & "(" & Subject & ")"
.Attachments.Add relativepath1 & filename
.HTMLBody = RangetoHTML(Range("E2:N16")) & "<img src ='cid:" & filename & "'>"
.Send
'.Display
End With
On Error GoTo 0
Set OutlookMessage = Nothing
Set OutlookApp = Nothing
End Sub
How do I convert the script from an Mail_Object to HTML so that I can properly format line 3 and 4 to be bullet points and then change the font on line 5?
I know nothing about HTML.
The following code runs but does not do any formatting or bullet points.
Sub Sample_Auto_Generated_Email_Final()
Set Mail_Object = CreateObject("Outlook.Application")
With Mail_Object.CreateItem(o)
.Subject = "Report"
.To = "XX#Xx.com"
.Body = MAR_Message_5()
.Send
End With
End Sub
Function MAR_Message_5() As String
MAR_Message_5 = "Line1" & vbNewLine & _
"Line 2" & vbNewLine & _
" • Line3" & _
" • Line4" & vbNewLine & _
Chr(10) & _
"Line 5" <-- I want this line to be Calabri 6 point font.
End Function
I test your code, please change your code to the below code:
Sub Sample_Auto_Generated_Email_Final()
Set Mail_Object = CreateObject("Outlook.Application")
With Mail_Object.CreateItem(o)
.Subject = "Report"
.To = "XX#Xx.com"
.HTMLBody = MAR_Message_5()
.Send
End With
End Sub
Function MAR_Message_5() As String
MAR_Message_5 = "<span>Line1132323213123" & vbNewLine & "</span><br>"
MAR_Message_5 = MAR_Message_5 & "<span>Line2132323213123" & vbNewLine & "</span><br>"
MAR_Message_5 = MAR_Message_5 & "<span>????Line3132323213123" & vbNewLine & "</span><br>"
MAR_Message_5 = MAR_Message_5 & "<span>????Line4132323213123" & vbNewLine & "</span><br>"
MAR_Message_5 = MAR_Message_5 & "<span>........Line5132323213123" & vbNewLine & "</span>"
End Function
<br> label can switch to the next line.
This is my result:
Reference from:
Sending html email from VBA email program
I have been trying to send a email via excel and use html in the message body but it seems excel does not reconize de <\li>. I have the microsoft html Oject library added.
Sub send()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "dupma4"
'.CC = "Patrick.Blouin#mern.gouv.qc.ca;Veronic.Cinq-Mars#mern.gouv.qc.ca"
.BCC = ""
.Subject = "Ajouts d'adresse | [" & mun & " " & ville & "] | [" & Format(Now(), "yyyy-MM-dd") & "]"
.HTMLBody = "Bonjour," & "<br>" & "<br>" _
& "<ul>" & "<li> & message1 & "</li>" & "<li>" & message2 _
& "</li>" & "</ul>"
'.Send
End With
End Sub
You're missing an ending quotation mark (") for your first li. So it should be as follows...
.HTMLBody = "Bonjour," & "<br>" & "<br>" _
& "<ul>" & "<li>" & message1 & "</li>" & "<li>" & message2 _
& "</li>" & "</ul>"
I'm trying to add an If-Then statement to my VBA in order to create two different email texts based on whether a specific field is populated in a table.
If no data is in the [VendorID/UIN] field in the t1stNoticeEmails table, I'd like this text:
"Please provide a current remit-to address as soon as possible so we can resend the check(s) to the intended recipient(s). The funds from this check will remain as a charge against the FOAPALs utilized in the transaction until this matter is resolved."
If there is data in the [VendorID/UIN] field in the t1stNoticeEmails table, I'd like this additional text:
"In addition, the Vendor ID associated with this transaction may need to be updated. Please contact Vendor Maintenance."
Here's the code:
Sub FirstEmail_IncorrectAddress_ReviewVBA()
Dim rst As DAO.Recordset
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Dim rst2 As DAO.Recordset
Dim strTableBeg As String
Dim strTableBody As String
Dim strTableEnd As String
Dim strFntNormal As String
Dim strTableHeader As String
Dim strFntEnd As String
Dim CheckNum As String
Dim NameOfRecipient As String
Dim StrSQL1 As String
Dim NameSpaceOutlook As Outlook.Namespace
gPARAttachment = "S:\...."
'SEND FIRST NOTICE EMAILS'
'------------------'
Set rst2 = CurrentDb.OpenRecordset("select distinct ContactEmails from t1stNoticeEmails WHERE CheckReturnReason = 'IncorrectAddress'")
If rst2.RecordCount = 0 Then 'checks if recordset returns any records and continues if records found and exits if no records found
Exit Sub
End If
rst2.MoveFirst
'Create e-mail item
Set olApp = Outlook.Application
Set objMail = olApp.CreateItem(olMailItem)
'Do Until rst2.EOF
Set olApp = Outlook.Application
Set objMail = olApp.CreateItem(olMailItem)
'Define format for output
strTableBeg = "<table border=1 cellpadding=3 cellspacing=0>"
strTableEnd = "</table>"
strTableHeader = "<font size=3 face='Calibri'><b>" & _
"<tr bgcolor=#4DB84D>" & _
td("CheckNumber") & _
td("PayeeName") & _
td("VendorID") & _
td("DocNo / ERNo / PONo") & _
td("Amount") & _
td("CheckDate") & _
td("OriginalCheckAddress1") & _
td("OriginalCheckAddress2") & _
td("OriginalCheckCity") & _
td("OriginalCheckState") & _
td("OriginalCheckZip") & _
"</tr></b></font>"
strFntNormal = "<font color=black face='Calibri' size=3>"
strFntEnd = "</font>"
Set rst = CurrentDb.OpenRecordset("SELECT * FROM t1stNoticeEmails where ContactEmails='" & rst2!ContactEmails & "' AND CheckReturnReason = 'IncorrectAddress' Order by FullName asc")
If rst.RecordCount = 0 Then
rst2.Close
Set rst2 = Nothing
Exit Sub
End If
rst.MoveFirst
NameOfRecipient = rst!FullName
CheckNum = rst!CheckNumber
'Build HTML Output for the DataSet
strTableBody = strTableBeg & strFntNormal & strTableHeader
Do Until rst.EOF
strTableBody = _
strTableBody & _
"<tr>" & _
"<TD nowrap>" & rst!CheckNumber & "</TD>" & _
"<TD nowrap>" & rst!FullName & "</TD>" & _
"<TD nowrap>" & rst![VendorID/UIN] & "</TD>" & _
"<TD nowrap>" & rst![DocNo / ERNo / PONo] & "</TD>" & _
"<TD align='right' nowrap>" & Format(rst!AmountDue, "currency") & "</TD>" & _
"<TD nowrap>" & rst!OriginalCheckDate & "</TD>" & _
"<TD align='left' nowrap>" & rst!OriginalCheckAddress1 & "</TD>" & _
"<TD align='left' nowrap>" & rst!OriginalCheckAddress2 & "</TD>" & _
"<TD align='left' nowrap>" & rst!OriginalCheckCity & "</TD>" & _
"<TD align='left' nowrap>" & rst!OriginalCheckState & "</TD>" & _
"<TD align='left' nowrap>" & rst!OriginalCheckZip & "</TD>" & _
"</tr>"
rst.MoveNext
Loop
'rst.MoveFirst
strTableBody = strTableBody & strFntEnd & strTableEnd
'rst.Close
'Set rst2 = CurrentDb.OpenRecordset("select distinct ch_email from t_TCard_CH_Email")
'rst2.MoveFirst
Call CaptureIABodyText
With objMail
'Set body format to HTML
.To = rst2!ContactEmails
.BCC = gIAEmailBCC
.Subject = gIAEmailSubject & " - Check# " & CheckNum & " - " & NameOfRecipient
.BodyFormat = olFormatHTML
.HTMLBody = .HTMLBody & gIABodyText
.HTMLBody = .HTMLBody & "<HTML><BODY>" & strFntNormal & strTableBody & " </BODY></HTML>"
.HTMLBody = .HTMLBody & gIABodySig
.SentOnBehalfOfName = ""
.Display
'.Send
End With
rst2.MoveNext
'Loop
rst.Close
Set rst = Nothing
rst2.Close
Set rst2 = Nothing
End Sub
This will give you an additional variable sAdditionalText that you can concatenate to your main string wherever you want:
Dim sAdditionalText As String
If IsNull(rst![VendorID/UIN]) Then
sAdditionalText = "Please provide a current remit-to address as soon as possible so we can resend the check(s) to the intended recipient(s). The funds from this check will remain as a charge against the FOAPALs utilized in the transaction until this matter is resolved."
Else
sAdditionalText = "In addition, the Vendor ID associated with this transaction may need to be updated. Please contact Vendor Maintenance."
End If
The code below creates an email. It only works on the first record of the db. Also, the code puts all of the fields in the body. I would like it to only put the fields that have "Request from Finance" in the field.
Private Sub cmdEMail_Click()
On Error GoTo cmdEMail_Click_Error
Dim OutApp As Object
Dim strEMail As String
Dim OutMail As Object
Dim strbody As String
strEMail = Me.EMail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Please add the following time codes to Oracle for Lilly Project 1005894. Thank you!" & vbCrLf _
& "" & vbCrLf & "INSTRUCTIONS:" & vbCrLf _
& "" & vbCrLf & "Make sure the Task Description starts with EU. This is automatically added by entering EU in the Contract field on the form." & vbCrLf _
& "" & vbCrLf & "If you wish to keep track of your time code requests, CC: yourself on the e-mail and considering entering a compound name or other identifier in the subject line. Alternatively, save a copy of the spreadsheet with your time codes to your desktop." & vbCrLf _
& "" & vbCrLf & "WRITING TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![WriterTaskNumberName] & vbCrLf _
& "" & vbCrLf & "ADD DRAFT TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![AddDraftTaskNumberName] & vbCrLf _
& "" & vbCrLf & "EDIT TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![EditTaskNumberName] & vbCrLf _
& "" & vbCrLf & "QUALITY REVIEW TASK NUMBER NAME =" & [Forms]![frm_Regulatory]![DataIntegrityQRTaskNumber] & vbCrLf _
& "" & vbCrLf & "Task Description =" & [Forms]![frm_Regulatory]![Text186] & vbCrLf
On Error Resume Next
If Me.ActiveWritingCode = "Request from Finance" Then
With OutMail
.To = strEMail
.CC = ""
.BCC = ""
.Subject = "Lilly EU 1005894 Time Code Request"
.Body = strbody & vbNewLine & .Body
.Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
End If
On Error GoTo 0
Exit Sub
cmdEMail_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdEMail_Click of Sub Form_frm_Regulatory"
End Sub
Here is a generic script to loop through records in a table.
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Contacts")
'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until rs.EOF = True
'Perform an edit
'rs.Edit
'rs!VendorYN = True
'rs("VendorYN") = True 'The other way to refer to a field
'rs.Update
'Save contact name into a variable
'sContactName = rs!FirstName & " " & rs!LastName
'Move to the next record. Don't ever forget to do this.
rs.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Finished looping through records."
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
Here is another example which is quite good.
https://msdn.microsoft.com/en-us/library/bb243789(v=office.12).aspx