I convert a worksheet into a PDF and am trying to have that PDF emailed to me and copied to another person. All of this will be assigned to an action button/trigger.
Option Explicit
Sub SendExcelFileAsPDF()
Dim OutlookApp As Outlook.Application
Dim emItem As Object
Dim Receipt As String, Subject As String
Dim Message As String, Fname As String
Dim Recipient As Outlook.Recipient
Recipient = "xxxxx.xxxxx#fedex.com"
Subject = "Weekly Critical Items" & " " & Range("L1")
Message = Range("D2") & Range("J2") & "Weekly Critical Items submitted" &
Range("L1") & " " & "in PDF Format"
Message = Message & vbNewLine & vbNewLine & "Offload Ops"
Fname = Application.DefaultFilePath & "/" & ActiveWorkbook.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fname
Set OutlookApp = New Outlook.Application
Set emItem = OutlookApp.CreateItem(olMailItem)
With emItem
.To = Recipient = "xxxxx.xxxxx#fedex.com"
.Subject = Subject
.Body = Message
.Attachements.Add Fname
.Send
End With
Set OutlookApp = Nothing
End Sub
The recipient line is where I am having issues. When I run the debugger, it's giving
Run-Time error '91: Object variable or with block variable not set
I would dim recipient as string and update the .to assignment:
Change
Dim Recipient As Outlook.Recipient
.To = Recipient = "dennis.aikens#fedex.com"
to
Dim Recipient As string
.To = Recipient
This line
.To = Recipient = "dennis.aikens#fedex.com"
Should be just
.To = Recipient
Related
I was trying to use the following code to insert a "Click here" link to link to the document that is open but I am having an issue.
When the email has been drafted and the link is inserted, only some of the hyperlink is carried over to the email, meaning that the hyperlink does not work.
I am trying the following to do this:
Private Sub Completion_Notification()
Dim xInspect As Object
Dim pageEditor As Object
Dim Strbody As String
Dim CommentsPath As String
Dim CommentsName As String
CommentsName = ActiveWorkbook.Name
CommentsPath = Application.ActiveWorkbook.FullName
Strbody = "Click Here"
'Getting the email List
Dim i As Integer
Dim Email_Rng As Range
Dim Num_of_Emails As Integer
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "Email"
.CC = ""
.Subject = "Email_Subject"
.HTMLBody = "<html><p>Hi, " & "</p>" & _
"<p>" & Strbody & _
"<p>" & "Many Thanks"
.Display
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
However, when I step into the code and check the value for the "strbody" expression the link is there in full so I have no idea why this would not be working. is there a Limit to the number of characters that can be inserted into the href?
To represent a link to a local file, Use <A HREF=""file://
Example
Option Explicit
Public Sub example()
Dim Strbody As String
Strbody = "<A HREF=""file://" & _
Application.ActiveWorkbook.FullName & _
""">Click Here</A>"
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
With OutMail
.HTMLBody = "<html><p>Hi, " & "</p>" & _
"<p>" & Strbody & _
"<p>" & "Many Thanks"
.Display
'.Send
End With
End Sub
Not sure why this is failing with a
"runtime error operation failed"
It seems to be crashing on the ".Attachments.Add fileName" line. I've read that you can run into issues if you are passing an object to the attachments, but I don't think I've done that.
Public Sub DraftEmailWithAttachment(strTo As String, strSubject As String, _
strBody As String, fileName As String)
Dim oApp As Object
Dim oEmail As Object
Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(0)
With oEmail
.To = strTo
.subject = strSubject
.Attachments.Add fileName
.display
.HTMLBody = strBody & oEmail.HTMLBody
End With
End Sub
and
Private Sub btnEmailActionItems_Click()
Dim fileName As String
Dim todayDate As String
Dim strTo As String
Dim strSubject As String
Dim strBody As String
Dim filter As String
Dim oApp As Object
Dim oEmail As Object
Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(0)
strTo = Nz(Me.cboUnderwriter.Column(2), "")
strSubject = Nz(Me.txtNamedInsured.Value, "") & " - " & _
Nz(Me.txtSubmissionNumber.Value, "") & " - " & _
Nz(Me.txtQuoteNumber.Value, "")
strBody = "Hello " & Me.cboUnderwriter.Column(3) & ", <br/><br/>"
todayDate = Format(Date, "MM.DD.YYYY")
fileName = "C:\Users\crewsj3\Desktop\tmp\Action Items Report -" & _
strSubject & " " & todayDate & ".pdf\"
filter = "submission_number=" & Nz(Me.txtSubmissionNumber.Value, "")
'generate filtered report
Call ExportFilteredReportToPDF("rptActionItemsForAllPolicies", fileName, filter)
'generate email
Call DraftEmailWithAttachment(strTo, strSubject, strBody, fileName)
End Sub
Any ideas?
Edit:
It looks like the problem was the trailing slash. works fine now. Thanks for the help.
The source of the attachment can be a file (represented by the full file system path with a file name) or an Outlook item that constitutes the attachment. See Attachments.Add for more information.
Based on the code listed above you just need to make sure the file path is valid and doesn't contain forbidden symbols. Try to copy the actual file path at runtime and paste it into any windows explorer window. Following that way, you can be sure that a file can be found and read.
I've edited my question based on the feedback. I have a form that I want users to be able to silently (no user input required) save and send with one button click.
The following code is saving as a .pdf with the correct name in the same document/path as the original file (which I want). However when the email is sent, the attachment is the original .docm file instead.
The final attachment must be a .pdf as it will be emailed to a Microsoft Team site and macro-enabled files will not work on Teams.
I'm new to VBA beyond basic commands for my own workflow. I'm working my way through various tutorials/courses and an extremely large book on vba for Office but I would appreciate a fix my newbie coding error sooner rather than later.
Private Sub btnSubmit_Click()
strName = ActiveDocument.SelectContentControlsByTitle("ddName")(1).Range.Text
strDate = ActiveDocument.SelectContentControlsByTitle("ddDate")(1).Range.Text
strTest = ActiveDocument.SelectContentControlsByTitle("ddTestNumber")(1).Range.Text
Dim strFilename As String
strFilename = strName & "_" & "VBATestFile_" & strTest & "_" & Format(strDate, "yyyymmdd") & ".pdf"
ActiveDocument.SaveAs2 strFilename, FileFormat:=wdFormatPDF
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = strName & " Test" & strTest
.Body = "Test email send for " & strName & " " & strTest & "."
.To = "email address here"
.Importance = olImportanceNormal
.Attachments.Add Doc.FullName
.Send
End With
Application.ScreenUpdating = True
MsgBox "Form Submitted", vbInformation
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
Solved:
Private Sub btnSubmit_Click()
strName = ActiveDocument.SelectContentControlsByTitle("ddName")(1).Range.Text
strDate = ActiveDocument.SelectContentControlsByTitle("ddDate")(1).Range.Text
strTest = ActiveDocument.SelectContentControlsByTitle("ddTestNumber")(1).Range.Text
Dim strFilename As String 'Create Filename based on data in Content Controls
strFilename = strName & "_" & "VBATestFile_" & strTest & "_" & format(strDate, "yyyymmdd") & ".pdf"
ActiveDocument.SaveAs2 strFilename, FileFormat:=wdFormatPDF 'Save as .pdf to Documents folder
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document
Dim sPathUser As String 'Get current file path
sPathUser = Environ$("USERPROFILE") & "\my documents\"
Application.ScreenUpdating = False 'Silently send email with .pdf file attached
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = strName & " Test " & strTest
.Body = "Test email send for " & strName & " " & strTest & "."
.To = "email address"
.Importance = olImportanceNormal
.Attachments.Add strFilename
.Send
End With
Application.ScreenUpdating = True
MsgBox "Form Submitted", vbInformation 'Confirm document submission for user
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End Sub
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.
I've a loop to send about 75 emails, each with an individual attachment for each individual recipient. This works, but I'm wondering how to create all these, and send them all in one go, instead of feeding them through one at a time.
I know I can use .display instead of .send to have the email show in Outlook, but is there any way to use VBA to temporarily disable sending emails, and then enable it once all mails are created?
My code looks something like this -
Dim employee_name As Variant
Dim file_path As String
Dim file_ext As String
Dim AGENT_FILE As String
Dim e As Variant
Dim email As Variant
Dim a As Integer
a = "0"
Sheets("EMAILS").Select
employee_name = Range("A1:A76").Value
file_path = "H:\Email TEST\"
file_ext = ".xlsx"
Dim OutApp As Object
Dim OutMail As Object
Dim distributionList As String
Set OutApp = CreateObject("Outlook.Application")
For Each e In employee_name
If e <> "" Then
Set OutMail = OutApp.CreateItem(0)
With Sheets("EMAILS").Select
a = a + 1
email = Range("B" & a).Value
AGENT_FILE = file_path & e & file_ext
On Error Resume Next
With OutMail
.To = email
.CC = ""
.BCC = ""
.Subject = "Daily Stats"
.Body = "Hello ," & vbCrLf & _
vbCrLf & _
"Attached are your daily stats." & vbCrLf & _
vbCrLf & _
"Regards, " & vbCrLf & _
"Oliver Lockett"
.Attachments.Add AGENT_FILE
.send
End With
End With
Set OutMail = Nothing
End If
Next
Set OutApp = Nothing
I had similar kind of stuff years ago...
I preferred using .save instead of .send. Because of this all emails where saved under drafts....once all Emails are saved....I had a macro in Outlook to send all drafts...
This can be acheived here
http://www.techrepublic.com/forum/questions/101-309127/send-all-mails-from-my-drafts-folder-at-one-go-in-outlook-2003
Why would you want to do that? Send is asynchronous, it will not block your code.