I have a converted document from .docx into .pdf saved to the desktop. The last task is to attach this .pdf to the body of an e-mail; the HTML signature should remain unchanged.
I think the problem is this line of code and I don't know how to correct it:
.Attachments.Add PdfFile.FullName
The complete code:
Public Sub Mail()
Dim LastAuthor As String
LastAuthor = ActiveDocument.BuiltInDocumentProperties("last Author")
Dim Email As String
Email = Replace(LastAuthor, " ", ".") & "#xyz.ro"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.Display
.Signature = "HTMLbody"
.To = Email
.CC = ""
.BCC = ""
.Subject = ActiveDocument.Name
'.Body = "AVIZAT. Multumesc mult"
'.Attachments.Add ActiveDocument.FullName
' You can add other files by uncommenting the following line.
'.Attachments.Add ("C:\test.txt")
' In place of the following statement, you can use ".Display" to
' display the mail.
.HTMLbody = "AVIZAT, esantionul este in ordine. Multumesc" & "<br>" & .HTMLbody
Dim objDoc As Document
Set objDoc = ActiveDocument
objDoc.ExportAsFixedFormat _
OutputFileName:=Replace(objDoc.FullName, ".docx", ".pdf"), _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, Item:=wdExportDocumentContent
' Add the attachment first for correct attachment's name with non English symbols
.Attachments.Add PdfFile.FullName
'.Preview 'Preview the email must disable .send & MsgBox (or use .Send to send it)
.send
MsgBox "E-mail trimis cu succes"
Set OutMail = Nothing
Set OutApp = Nothing
End With
End Sub
This will do:
Public Sub Mail()
Dim LastAuthor As String
Dim Email As String
Dim MyPdfName As String
Dim objDoc As Document
LastAuthor = ActiveDocument.BuiltinDocumentProperties("last Author")
Email = Replace(LastAuthor, " ", ".") & "#xyz.ro"
Set objDoc = ActiveDocument
MyPdfName = Replace(objDoc.FullName, ".docx", ".pdf")
objDoc.ExportAsFixedFormat _
OutputFileName:=MyPdfName, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, Item:=wdExportDocumentContent
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
.To = Email
.CC = ""
.BCC = ""
.Subject = objDoc.Name
.HTMLBody = "<BODY style=font-size:12pt;font-family:Calibri>Servus<br>Esantionul este in ordine.<br><br>Multumesc,<br>" & .HTMLBody
.Attachments.Add MyPdfName
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "E-mail trimis cu succes"
End Sub
It's far from perfect but is a lot clearer now and most importantly, works.
Related
I am trying to add an attachment functionality to my emails. My email code is working however the attachments are being sent as ATT00001.bin files.
The variable Forms![frmMain]!TabCtl54.Pages("page56").Controls("subtblcontent").Form![attachmentlnk] is a textbox on a form which is where I would put my file name.
attachmentlnkvar = "file:///C:/Users/desktopname/Desktop/" & Forms![frmMain]!TabCtl54.Pages("page56").Controls("subtblcontent").Form![attachmentlnk] & ".pdf"
With cdomsg
.To = emailstr
.FROM = fromemailstr
.subject = Forms!frmMain.txtSubject
.Attachments.Add attachmentlnkvar
.HTMLBody = strHTML
.Send
End With
Set cdomsg = Nothing
Is there a way I can send my files as pdfs?
I am happy to share with you the function which I use to sent all my emails:
Public Sub SendMessage(Optional SubjectText = "", Optional BodyText = "", Optional AttachmentPath = "", Optional sendTo = "", Optional sendCC = "", Optional DeliveryConfirmation = True, Optional DisplayDoNotAutoSend = True, Optional SendHighPriority = True, Optional UseHTML = True)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim MultipleAttachmentPath As String
Dim CurrentAttachment As Variant
Dim aAtachments() As String
On Error GoTo ErrorMsgs
DoCmd.Hourglass True
' Create the Outlook session.
Set objOutlook = New Outlook.Application
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
If UseHTML Then
.BodyFormat = olFormatHTML
End If
If Not isnull(sendTo) And InStr(sendTo, "#") > 0 Then
.To = sendTo
End If
If Not isnull(sendCC) And InStr(sendCC, "#") > 0 Then
.CC = sendCC
End If
.Subject = SubjectText
If UseHTML Then
.HTMLBody = "<div style='font-family:Calibri,sans-serif'>" & BodyText & GetThankYouSignature & "</div>"
Else
.Body = BodyText & vbCrLf & GetUserFullNameInASCIIText & vbCrLf & vbCrLf
End If
If SendHighPriority Then
.Importance = olImportanceHigh 'High importance
End If
If DeliveryConfirmation Then
.OriginatorDeliveryReportRequested = True
.ReadReceiptRequested = True
End If
On Error Resume Next
If AttachmentPath <> "" Then
' Add attachments to the message.
If Not IsMissing(AttachmentPath) And InStr(AttachmentPath, ";") = 0 Then
Set objOutlookAttach = .Attachments.add(AttachmentPath)
ElseIf Not IsMissing(AttachmentPath) And InStr(AttachmentPath, ";") > 0 Then
aAtachments = Split(AttachmentPath, ";")
For Each CurrentAttachment In aAtachments
.Attachments.add (CurrentAttachment)
Next
End If
End If
On Error GoTo ErrorMsgs
End With
If DisplayDoNotAutoSend Or isnull(sendTo) Then
objOutlookMsg.Display
Else
objOutlookMsg.Send
End If
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing
DoCmd.Hourglass False
Exit Sub
ErrorMsgs:
DoCmd.Hourglass False
If Err.Number = "287" Then
MsgBox "You clicked No to the Outlook security warning. " & _
"Rerun the procedure and click Yes to access e-mail" & _
"addresses to send your message. For more information," & _
"see the document at http://www.microsoft.com/office" & _
"/previous/outlook/downloads/security.asp. "
Else
Call LogError(Err.Number, Err.Description, "SystemUtilities", "SendMessage")
Resume Next
Resume
End If
End Sub
The variable AttachmentPath can contain multiple paths to attachments delimited by ";"
Don't use file:// etc., just the path. And backslashes.
attachmentlnkvar = "C:\Users\desktopname\Desktop\" & Forms![frmMain]!TabCtl54.Pages("page56").Controls("subtblcontent").Form![attachmentlnk] & ".pdf"
Instead of .Attachments.Add attachmentlnkvar have you tried .AddAttachment attachmentlnkvar? That's what I use to send PDF reports via an SMTP server instead of Outlook.
The problem is with your SMTP server. Try putting the attachment after the body to avoid this problem. If that doesn't work, try sending the message as plain text instead of HTML using:
.TextBody = bodyText
EXAMPLE:
attachmentlnkvar = "C:/Users/desktopname/Desktop/" & Forms![frmMain]!TabCtl54.Pages("page56").Controls("subtblcontent").Form![attachmentlnk] & ".pdf"
With cdomsg
.To = emailstr
.FROM = fromemailstr
.Subject = Forms!frmMain.txtSubject
.HTMLBody = strHTML
.AddAttachment attachmentlnkvar
.Send
End With
Set cdomsg = Nothing
EXPLANATION:
https://kb.mit.edu/confluence/pages/viewpage.action?pageId=4981187
Got a macro running through columns with mail addresses using most parts from Ron de Bruin.
The macro runs through just fine, but only sends the first hit in column B and doesn't display any of the other hits when i try to watch it? What could be the issue?
The code is so that I can get the default signature from outlook, thats why it's .Display first in the code.
Sub mail_HTML()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
strbody = "<H3>Hei " & Cells(cell.Row, "E").Value & "</H3>" _
& "<p>" & Range("k4") & "<p>"
On Error Resume Next
With OutMail
.Display
.To = cell.Value
.Subject = Range("K12").Value
.HTMLBody = strbody & .HTMLBody
'You can add files also like this
'.Attachments.Add Range("O1").Value
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
When you set
Set OutMail = Nothing
You dont have any access to the object anymore (because it is destroyed). But you set it before the loop. You need to set it in every loop then like this:
On Error Resume Next
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
.To = cell.Value
.Subject = Range("K12").Value
.HTMLBody = strbody & .HTMLBody
'You can add files also like this
'.Attachments.Add Range("O1").Value
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
So after 1 Email the oject is destroyed, but you are not aware because of the on error resume next
Tried that but it is not working for me, here is my code:
Do Until in_file.EOF
Email_To = in_file!email_address
Email_Bcc = ""
Email_Body = in_file!email_salut & " " & in_file!email_name & ", test this."
Email_Subject = "Email Subject"
Set mail_object = CreateObject("Outlook.Application")
Set mail_single = mail_object.CreateItem(0)
With mail_single
.Subject = Email_Subject
.To = Email_To
.cc = Email_Cc
.BCC = Email_Bcc
.Body = Email_Body
.send
End With
Set mail_object = Nothing
Set mail_single = Nothing
in_file.MoveNext
Loop
I have an Excel Document in a Template. Users input information and Save As a new genericized number. They then hit a button that auto populates an email to one of 5 people using Vlookup and based on the cost margin.
The file is Save As'd but the e-mail recipient cannot open the file, it reads invalid location. I can close and reopen the new renamed sheet and drag it into an e-mail. I need to link to the newly saved file's name that appears in the email.
Sub Email_created_Workbook()
Dim OutApp As Object
Dim OutMail As Object
Dim Mess As Object, Recip
Recip = [Sheet1!B28].Value & "; " & [Sheet1!B27].Value
Dim strbody As String
If ActiveWorkbook.Path <> "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<font size=""3"" face=""Calibri"">" & _
"Hello,<br><br>" & _
"There is a New PO awaiting your approval :<br><B>" & _
ActiveWorkbook.Name & "</B> is created.<br>" & _
"Click on this link to open the file : " & _
"<A HREF=""file://" & ActiveWorkbook.FullName & _
""">Link to Workbook</A>" & _
"<br><br>Regards," & _
"<br><br>Automated Approval System</font>"
On Error Resume Next
With OutMail
.To = Recip
.CC = ""
.BCC = ""
.Subject = ActiveWorkbook.Name
.HTMLBody = strbody
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Else
MsgBox "The ActiveWorkbook does not have a path, Save the file first."
End If
End Sub
The file name does adapt in my e-mail, from PO Template, but will not open.
I believe this will help you with your current issue (closing and reopening your file before sending). I've removed the the two lines of your code where you set the Outlook objects to Nothing. To reopen the current file you can use the OnTime function like so:
Sub Email_created_Workbook()
Dim OutApp As Object
Dim OutMail As Object
Dim Mess As Object, Recip
Recip = [Sheet1!B28].Value & "; " & [Sheet1!B27].Value
Dim strbody As String
If ActiveWorkbook.Path <> "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<font size=""3"" face=""Calibri"">" & _
"Hello,<br><br>" & _
"There is a New PO awaiting your approval :<br><B>" & _
ActiveWorkbook.Name & "</B> is created.<br>" & _
"Click on this link to open the file : " & _
"<A HREF=""file://" & ActiveWorkbook.FullName & _
""">Link to Workbook</A>" & _
"<br><br>Regards," & _
"<br><br>Automated Approval System</font>"
On Error Resume Next
With OutMail
.To = Recip
.CC = ""
.BCC = ""
.Subject = ActiveWorkbook.Name
.HTMLBody = strbody
.Display 'or use .Send
End With
Application.OnTime Now + TimeValue("00:00:10"), "SendEmail"
ThisWorkbook.Close True 'True= yes, save changes
Else
MsgBox "The ActiveWorkbook does not have a path, Save the file first."
End If
End Sub
Sub SendEmail()
Dim OutApp As Object: Set OutApp = GetObject(, "Outlook.Application") 'Grab current instance of Outlook since we already opened the instance prior to restarting Excel
Dim oInspector As OutApp.Inspector: Set oInspector = OutApp.ActiveInspector
Dim NewMail As OutApp.MailItem: Set NewMail = oInspector.CurrentItem 'Grab currently open New/Compose Mail window
NewMail.Send 'Send Email
End Sub
Let me know if this helps resolve your issue.
Using the object "Outlook.Application", I send an e-mail using VBA Access. In the body, I put a string like this:
Email = "Random things" & Chr(13) _
& "More random things" & Chr(13) _
If I show the string Email in a MsgBox it is displayed correctly, but when I send it, the linebreaks are deleted.
I've tried with:
Chr(13)
vbCrLf
vbCr
But all three have the same result:
Try This:
Sub OutlookEmail()
Dim AppOutlook As Outlook.Application
Set AppOutlook = CreateObject("Outlook.application")
Dim Mail As MailItem
Set Mail = AppOutlook.CreateItem(olMailItem)
Dim Email As String
Email = "Random things" & vbNewLine _
& "More random things" & vbNewLine
'Generate Email
Mail.Subject = "Test Subject"
Mail.To = "Test#test.com"
Mail.Body = Email
Mail.Display
Set Mail = Nothing
Set AppOutlook = Nothing
End Sub
Tested it my self appears to work correctly on my PC.
The code below display the email in Outlook. To send, change .Display to .Send
Sub SendDisplayEmail(strEmailFrom As String, strEmailTo As String, strEmailCC As String, strEmailBCC As String, strSubject As String)
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0) ' olMailItem
Debug.Print ("From: " & strEmailFrom & ", To: " & strEmailTo & ", cc: " & strEmailCC & ", bcc: " & strEmailBCC & ", file: " & xFile)
On Error Resume Next
OutMail
With OutMail
.to = strEmailTo
.CC = strEmailCC
.BCC = strEmailBCC
.Subject = strSubject
'.Body = "Random things" _
' & vbCrLf & vbCrLf & "More random things." _
.BodyFormat = 2 ' olFormatHTML
.HTMLBody = "<html>Random things<br>More random things.</html>"
'.Body = strBody
'.Save
.Display
'.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
You can use the HTMLBody (with .BodyFormat = 2) for a nice formated e-mail or .Body for the plain text e-mail. Note that %0D%0A and dont work in HTMLBody because Outlook parse it.
When I send emails they go out from my personal inbox at work, but I need them to go out from another mailbox that I have access to. I have both mailboxes in my outlook.
Can I send emails from a specific mailbox?
Here is the code I am using. It does not find the 2nd item in my account.
Sub Mail_small_Text_Change_Account()
Dim cel As Range
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
On Error Resume Next
For Each cel In Range(("C2"), Range("C2").End(xlDown))
With OutMail
.To = cel.Value
'.CC = cel.Offset(0, 3).Value
.Subject = "Benefits Refund"
.Body = strbody
.SendUsingAccount = OutApp.Session.Accounts.Item(2)
.Send 'or use .Display
End With
Next
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Yes. Using a POP mail box, you can specify the user name and password for any account.
.To = "E#E.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "This is the body"
.SendUsingAccount = OutApp.Session.Accounts.Item(1)