I am trying to attach a worksheet saved as a pdf as an attachment on an email.
I've managed to figure out how to save pdfs, and I know how to save worksheets as pdfs, but I want to be able to attach the pdf to the email without having a hard copy of the pdf saved down. Is this possible?
Feel free to use this code I found, with a little modification you can get it working quite easily! :)
Private Sub GenerateEmail(TemplateFileName As String, AttachmentFilePath As String, tableRange As Range, subjectText As String, Optional AdditionalCC As String)
Application.ScreenUpdating = False
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
'''' This will use a pre-existing template, otherwise use commented out line below is and cut this line out
Set OutMail = OutApp.CreateItemFromTemplate(TemplateFileName)
'Set OutMail = OutApp.CreateItem(0)
With OutMail
'.Recipients.Add AdditionalCC
'.sendTo = sendToText
'.CC = sendCCText
'.BCC = sendBCCText
'.Subject = subjectText
'''' Use this for current Workbook (ONLY IF SAVED) ie. You'll need to create a function to save the Workbook first
'.Attachments.Add (ActiveWorkbook.FullName)
'''' Use this if you know the location for the saved Workbook
.Attachments.Add (AttachmentFilePath)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
If you'd like to review the website I acquired this from, click here
Related
I am attempting to add a chart into the body of my email using GetInspector and WordEditor.
I am having difficulty simultaneously adding text into the body as well. Based on the paragraph position I choose, I can either have the text appear or the chart, but not both at the same time.
Code sample:
Sub generateEmail()
Dim OutApp as Object
Dim OutMail as Object
Dim filePath as String
Dim cht as ChartObject
Dim vInspector as Object
Dim wEditor as Object
Set cht = wsData.ChartObjects("Chart 2")
cht.copy
With wsHome
filePath = ""
'also including an attachment which is working fine
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set vInspector = OutMail.GetInspector
Set wEditor = vInspector.WordEditor
On Error Resume Next
With OutMail
.to = "All"
.CC = ""
.BCC = ""
.Subject = "Test"
.display
wEditor.Paragraphs(1).Range.Text = "Please see attached"
wEditor.Paragraphs(2).Range.Paste
'if I comment out paragraph 1 and change the second line to paragraph 1
'the chart prints perfectly, but the text does not show
'the way its set up now, only the "Please see attached" shows up
.Attachments.Add (filePath)
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I'm definitely missing something with the way paragraphs are read with the wordEditor, but have not used it enough to troubleshoot effectively.
On Error Resume Next hides the error that is occurring. Remove it and you'll get
Run-time error '5941': The requested member of the collection doesn't exist.
The email body only has 1 paragraph; you can't paste into paragraph 2 because it doesn't exist. Maybe Add a 2nd paragraph and then paste:
wEditor.Paragraphs(1).Range.Text = "Please see attached"
wEditor.Paragraphs.Add
wEditor.Paragraphs(2).Range.Paste
So I have a task to automate. We have a protected spreadsheet (users only have 'read' access to) that get's updated by admins from time to time in order to add/remove users from a paid subscription mailing list. I'm trying to make the process of sending these emails out simpler to speed up the process and eliminate the potential of human error getting involved.
So email addresses are listed under the 'C' column, lists can be as long as in the tens of thousands, or it may only be 1 or 2. The workbook has several sheets that specify the data set that the subscribers subscribe to. So I put something together that worked
'This function will grab the information the macro asks for
Function RangeToString(ByVal myRange As Range) As String
RangeToString = ""
If Not myRange Is Nothing Then
Dim myCell As Range
For Each myCell In myRange
RangeToString = RangeToString & "; " & myCell.Value
Next myCell
'Remove extra comma
RangeToString = Right(RangeToString, Len(RangeToString) - 1)
End If
End Function
Sub EmailTest1()
Dim OutApp As Object
Dim OutMail As Object
Dim strSubject As String
Dim myString As String
Dim rng As Range
Dim strCopy As String
'Sheet1 would be Sheet2/3/4/etc. depending on what list we're pulling from.
Set rng = Sheet1.Range("c2:c90000")
myString = RangeToString(rng)
strCopy = "internal.private#email.com; internal1.private#email.co;
internal2.private#email.co"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate("\\Domain\EmailTemplate\oft\test1.oft")
On Error Resume Next
With OutMail
.BCC = myString + strCopy
.Display
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Then I had repeats of the second part that specify the different lists/email templates as individual macros within the Add-In. (.Send will not be commented out when I do finally get the results I want).
So this works perfectly, when the macro specifies and embeds a workbook into itself. So for a while, I thought that it was pulling everything fine, until I used a blank workbook, and it still pulled the data I wanted, so I checked and double checked that there was no reference to the original workbook, and then I discovered that the workbook was built into the macro. I tried rebuilding the add-in using the same code, and it just doesn't work.
So my question is, is there a way to build this macro so that it'll work on any active workbook? I imagine there has got to be a simple thing to click on or something else I'm overlooking. I'm working with Excel 2016.
first of all, why didn't you just make a macro-embedded template where you have a form that connects any active workbook.
dim ws as workbook
set ws=activeworkbook
so basically make a form that is modular then on a label click event put that code.
then an execute button so that you can determine if you connect the right workbook before you start the email sending automation
I think you can adapt this to suit your needs.
Make a list in Sheets("Sheet1") with :
In column A : Names of the people
In column B : E-mail addresses
In column C:Z : Filenames like this C:\Data\Book2.xls (don't have to be Excel files)
The Macro will loop through each row in "Sheet1" and if there is a E-mail address in column B
and file name(s) in column C:Z it will create a mail with this information and send it.
Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*#?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Testfile"
.Body = "Hi " & cell.Offset(0, -1).Value
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
https://www.rondebruin.nl/win/s1/outlook/amail6.htm
I have this code that I can use to send out e-mails with vba in Excel.
Using .body instead of .Inspector.WordEditor I can type exactly what I want to be in the e-mail, but I want the text of the e-mail to be a Word document with some pictures in it and stuff.
How would I go about that? I cannot get .Inspector.WordEditor to work the way that I want it to. (To be honest it does not work at all for me)
Sub Test1()
Dim networkstatus As Boolean
If InternetGetConnectedState(0&, 0&) Then
networkstatus = True
Else
networkstatus = False
End If
If Not networkstatus = True Then
Exit Sub
End If
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
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
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Test"
.Inspector.WordEditor ("C:\test.docx")
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Edit: I am aware that you can use HTMLBody, but I do not count on my colleagues to use that.
Send it as an attachment instead
.Attachments.Add("C:\test.docx")
I have been assigned to send out Christmas greetings that have been customized to specific customers. However, these greetings are in the 100's and doing it automatically would save me hours - and these greetings are done every year!
In Excel, the customer names are listed in column A, the individual emails in column B, and the path to the individual customized greeting file in column C.
What I have currently found is a VBA code that offers me the option to attach (but not embed) these files through their paths to the individual emails.
Might anyone explain to me and/or demonstrate how to embed the attached files that are found through column C ?
Thank you very much!
What I have now is the following:
Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*#?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = cell.Value
.Subject = "Merry Christmas!"
.Body = "Merry Christmas!"
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value, olByValue, 0
End If
End If
Next FileCell
.Send 'Or use .Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
You could do using HTML email, something like
Set o = Application.CreateItem(olMailItem)
o.BodyFormat = olFormatHTML
o.HTMLBody = "<img src='C:\Users\Pictures\a1.png'>"
o.Display
I'm by no means an expert and I want to send the multiple and different attachments (e.g. Person1 receives BOTH attch.1 and attach.2; Person2 receives attch.3 and attch. 5 etc).
My code:
Sub SendEmail(what_address As String, subject_line As String, mail_body As String)
Dim dlApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)
olMail.To = what_address
olMail.Subject = subject_line
olMail.Body = mail_body
olMail.Send
End Sub
Sub SendMassEmail()
Dim mail_body_message As String
Dim title As String
row_number = 1
Do
DoEvents
row_number = row_number + 1
mail_body_message = Sheet1.Range("D2")
title = Sheet1.Range("B" & row_number)
mail_body_message = Replace(mail_body_message, "replace_name_here", title)
Call SendEmail(Sheet1.Range("A" & row_number), "This is a test", mail_body_message)
Loop Until row_number = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
End Sub
I think your code requires some work but the snippet below should help with adding multiple attachments. I have tried to add annotations that might be helpful.
Please note that the full path for each attachment must be known.
For example:
C:\TestFolder\TestSubfolder\TestFile.txt
You should be able to use the same looping concept to traverse across columns to handle multiple emails. It would be difficult to suggest the exact looping to be used without knowing the structure of your spreadsheet.
Sub GenerateEmails()
Dim OutApp As Object
Dim OutMail As Object
Dim myRange As Range
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = Outlook.Application.CreateItem(olMailItem)
'This will only generate a single email with multiple attachments.
'You will need another loop or something similar to process multiple emails the loop could
'be similar to the loop below that use offset to go down rows but instead
'you will offest across columns
With OutMail
'I have used hard coded cell ranges to define the values but you can use other
'methods.
.Subject = Range("A1").Value
.To = Range("A2").Value
.CC = Range("A3").Value
.Body = Range("A4").Value
'This is where you list of attachments will start
Set myRange = Range("A5")
'Keep going down one cell until no more attachment values are provided
Do Until myRange.Value = ""
'The value here needs to be the full attachment path including file name and extension
.Attachments.Add (myRange.Value)
'Set the range to be the next cell down
Set myRange = myRange.Offset(1, 0)
Loop
'This displays the email without sending.
.Display
'Once the code is correct you can use the .Send instead to actually send the emails.
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub