I made a 2 cell contain Date (B2:B10) and Time (C2:C10).
I declare the cell so that it will send email based on date & time in cell but it show automation error
Sub Send_Deferred_Mail_From_Excel()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim cell As Range
Set cell = Range("B2:C2")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
'Send Email Using Excel VBA Macro Code
With OutlookMail
.To = "gaelvin#gmail.com"
.CC = "nickjames#gmail.com"
.BCC = ""
.Subject = "Happy New Year"
.Body = "Greeting Gael, Wish You a Very Happy New Year"
'Send email on specific date & time
.DeferredDeliveryTime = Range("B2:C2")
.Display 'or just put .Send to directly send the mail instead of display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
DeferredDeliveryTime accepts a date as a value, so you need to combine the date and time that you have into a single value.
Due to the way dates work in VBA, you can simply add them together and it should work:
.DeferredDeliveryTime = Range("B2") + Range("C2")
I would also suggest to add some checks that those ranges contain valid time and dates if you have the chance.
Related
I'm using VBA to make automating emails from Excel to outlook however when I'm running my code it show compile error: variable not defined
I'm trying using from this source : https://beebole.com/blog/automating-emails-from-excel-employee-bonus/#copy
But, I only use Name, First Name, Send To, Email Subject, Email Body and Single-Send Link. For my Email Subject and Email Body I don't use any formula.
This my code in VBA
MY table for single-send link having an error
Formula in excel :
=HYPERLINK(“mailto:“&[#[Send To]]&”?subject=”&[#[Email Subject]]&”&body=”&[#[Email Body]],”SEND”)
[
Sub EmailAll()
Dim oApp As Object
Dim oMail As Object
Dim SendToName As String
Dim theSubject As String
Dim theBody As String
For Each c In Selection 'loop through (manually) selected records
'''For each row in selection, collect the key parts of
'''the email message from the Table
SendToName = Range("C" & c.Row)
theSubject = Range("D" & c.Row)
theBody = Range("E" & c.Row)
'''Compose emails for each selected record
'''Set object variables.
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
'''Compose the customized message
With oMail
.To = SendToName
.Subject = theSubject
.Body = theBody
''' If you want to send emails automatically, use the Send option.
''' If you want to generate draft emails and review before sending, use the Display option.
''' Do not use both!
'''To activate your chosen option: Remove the single quote from the beginning of the code line, then
'''add the single quote back to the option you didn't choose
.Display
'.Send
End With
Next c
End Sub
Can anyone help me to solve this problem
I am trying to pull email addresses from a column in an Excel Data table and have those email addresses be the receiver of email based on a template.
Code I made below.
Sub Mail_experiment()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.Mailtem
Set OutApp = CreateObject("Outlook.Application")
Set = OutMail
OutApp.CreatItemFromTemplate("C:\Users\Name\Documents\Project\PO Accrual Support Email Template.oft")
On Error Resume Next
With OutMail
.To = "J.Doe#gmail.com"
.CC = ""
.BC = ""
.Subject = ""
.Save
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
All separate emails will be sent later, hence .Save. Also, I am attempting to pull what would be the subject line of the email from another column in the data table.
How would I achieve both concepts with what I have so far?
You should create a function that returns a new MailItem based on your template. In this way, you will be able to test the new MailItem separately without having to run the complete code.
I like to enumerate my excel columns. This makes it both easier to refer to the correct column and to update the code if the column order is changed.
Option Explicit
'Enumeration is by defination the action of establishing the number of something
'I Enumerate my Worksheet Columns to give them a meaningful name that is easy to recognize
Public Enum EmailColumns
ecEmailAdresses = 1
ecSubject = 3
End Enum
Public Sub SaveEmails()
Dim r As Long
'The With Statement allows you to "perform a series of statements on a specified object without specifying the name of the object multiple times"
'.Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row actually refers to ThisWorkbook.Worksheets("Support Emails").Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
With ThisWorkbook.Worksheets("Support Emails")
'.Cells(): references a cell or range of cells on Worksheets("Support Emails")
'.Cells(.Rows.Count, ecEmailAdresses): Refrences the last cell in column 1 of the worksheet
'.End(xlUp): Changes the refererence from the last cell to the first used cell above the last cell in column 3
'.Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row: returns the Row number of the last used cell in column 3
For r = 2 To .Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
getPOAccrualTemplate(MailTo:=.Cells(r, ecEmailAdresses), Subject:=.Cells(r, ecEmailAdresses)).Save
Next
End With
End Sub
Public Function getPOAccrualTemplate(MailTo As String, Optional CC As String, Optional BCC As String, Optional Subject As String) As Object
Const TEMPLATE_PATH As String = "C:\Users\Name\Documents\Project\PO Accrual Support Email Template.oft"
Dim OutApp As Object, OutMail As Object
' CreateObject("Outlook.Application"): Creates an instance of an Outlook Application.
' Outlook.Application.CreateItemFromTemplate returns a new MailItem Based on a saved email template
Set OutMail = CreateObject("Outlook.Application").CreateItemFromTemplate(TEMPLATE_PATH)
With OutMail
.To = MailTo
.CC = CC
.BCC = BCC
.Subject = Subject
End With
'Returns the new MailItem to the caller of the function
Set getPOAccrualTemplate = OutMail
End Function
Immediate Window Tests
'Test getPOAccrualTemplate
' Assign Values to Varaible
MailTo = "ti#stackoverflow.com"
CC = "efrenreyes#youdontwantnoneson.com"
BCC = "alexp#gmail.com"
Subject = "Who is going to the tournament tonight?"
'Test Variables using "," to insert Tabs between values
?MailTo, CC, BCC, Subject
?MailTo;"-";CC;"-";BCC;"-";Subject
'Pass variables into getPOAccrualTemplate and return a new MailItem based on the template
'variables created in the immediate window are Variant Type
'CStr is used to cast the values to Strings
set OutMail = getPOAccrualTemplate(CStr(MailTo), CStr(CC), CStr(BCC), CStr(Subject))
'Find out what type of object was returned
?TypeName(OutMail)
'Display the Mail Item
OutMail.Display
'Test Enumerate Columns
Columns(EmailColumns.ecEmailAdresses).Select
Columns(ecSubject).Select
MailTo = Cells(2, ecEmailAdresses)
CC = ""
BCC = ""
Subject = Cells(2, ecSubject)
'Test the function directly
getPOAccrualTemplate(CStr(MailTo), CStr(CC), CStr(BCC), CStr(Subject)).Display
'Test SaveEmails() Make sure and add a breakpoint
SaveEmails
?.Cells(.Rows.Count, ecEmailAdresses).End(xlUp).Row
Video Tutorials
These are two videos from my favorite VBA tutorial series that are relevant:
Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)
Excel VBA Introduction Part 26 - Constants and Enumerations (Const, Enum)
You should just slightly refactor your code. The macro sending the email should take (at least) the email adress and the subject in parameter:
Sub Mail_experiment(ByVal address As String, ByVal subject As String)
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.Mailtem
Set OutApp = CreateObject("Outlook.Application")
Set = OutMail
OutApp.CreatItemFromTemplate("C:\Users\Name\Documents\Project\PO Accrual Support Email Template.oft")
On Error Resume Next
With OutMail
.To = address '<-- use the input here
.CC = ""
.BC = ""
.Subject = subject '<-- use the input here
.Save
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Hence, supposing you have the email addresses in the column A and the subjects in the column B (from 1 to 10, for example), you'd just need to call the macro in a loop:
For j = 1 To 10
Mail_experiment Range("A" & j), Range("B" & j)
Next j
The above will call the Mail_experiment macro 10 times, each time passing a new parameter (A1 - B1, then A2 - B2 etc.)
I'm trying to, in Excel 2016, send an email in Outlook 2016 with a table in the email body.
I've researched Stack Overflow as well as other websites. I find the HTML part confusing.
Below is the code I've written, to send an email. The code works, but I need to replace the .HTMLBody = "Hello World" with a table.
Sub Send_mail()
Dim outlookApp As Outlook.Application
Dim outlookMail As Outlook.MailItem
Set outlookApp = New Outlook.Application
Set outlookMail = outlookApp.CreateItem(olMailItem)
With outlookMail
.To = "recipient#mail.com"
.CC = ""
.BCC = ""
.Subject = "TEST123"
.BodyFormat = olFormatHTML
.HTMLBody = "Hello World"
.Send
End With
Set outlookMail = Nothing
Set outlookApp = Nothing
End Sub
The table to insert in the body of the email consists of columns A, B, C and D.
The data always begin on row 2 but the row containing the last data needs to be dynamic.
The table will always be fairly small - max 20 rows ish.
I imagine the following might do the trick?
Locating the last populated row then looping to go through each row between 2 and the last populated row and convert it into HTML format and storing that as a string. Then concatenate those strings into one final string to put in the body of the email.
I've looked at Ron de Bruin's guides, but I would like to achieve this without having to create a temporary file or use non-Microsoft tools. The macro will have several users from a professional company, and needs to be bulletproof. I fear that saving temporary files and deleting them could result in horrible mistakes if the company's shared-folder structure is changed.
To Copy From Column A2: to Column D/or Column 4 last used range, Example would be
With ThisWorkbook.Worksheets("Sheet1")
Dim rng As Range
Set rng = .Range("$A$2:" & .Cells( _
.Rows.Count, 4) _
.End(xlUp).Address)
Debug.Print rng.Address ' Print on immediate Window
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
End With
See Copy Excel range as Picture to Outlook
I'm upgrading an Excel macro. I want to generate an email copying in a table that changes range daily.
Strbody populates the email but the timetable isn't attaching.
Sub Ops_button()
'Working in Office 2000-2010
Dim Outapp As Object
Dim Outmail As Object
Dim Strbody As String
Dim Timetable As String
'Auto Email Attachment Variables
Set Outapp = CreateObject("Outlook.Application")
Set Outmail = Outapp.createitem(0)
Timetable = Sheets("sheet1").Range("C2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Strbody = "body text."
On Error Resume Next
With Outmail
'Send email
.To = ""
.bcc = ""
.Subject = "Report" & " " & Format$(Date, "dd-mm-yyyy")
.body = Strbody & Timetable
On Error Resume Next
.Display
End With
On Error GoTo 0
Set Outmail = Nothing
Set Outapp = Nothing
End Sub
You can't do this the way you're trying to do it... Let's see why not :)
You've declared Timetable as a String type variable. In this statement, you're assigning its value as the return from the .Select method (which will return a value of True if there is no error).
Timetable = Sheets("sheet1").Range("C2").Select
So, you're in no way appending the Table's Range object to the string, in this statement:
.body = Strbody & Timetable
Instead, you really need to either convert the table to HTML or copy and paste the range directly from Excel to Word.
Use Ron de Bruin's function to convert the table to an HTML PublishObject and insert that to the email, or
.Display the MailItem and then get a handle on the MailItem's .Inspector object (which is really just a Word document)
For the solution 1, adapt the answer already given, here:
Paste specific excel range in outlook
For the solution 2, you'll need to use the method outlined here to get the Inspector (Word Document representing the Email item):
https://msdn.microsoft.com/en-us/library/office/ff868098.aspx
Then, Dim TimeTable as Range, and change code to:
Set Timetable = Sheets("sheet1").Range("C2").End(xlToRight).End(xlDown)
Then, copy the table:
Timetable.Copy
And then following the MSDN link above once you have a handle on the Inspector, get the destination range in Outlook (Word) and you can use the PasteAndFormat method of a Word.Range object:
Dim wdRange as Object 'Word.Range
OutMail.Display
Set wdRange = OutMail.getInspector().WordEditor.Range
wdRange.Text = strBody
wdRange.Expand (1)
wdRange.Characters.Last.PasteAndFormat 16 'wdFormatOriginalFormatting
Option 2 would be my preferred method. I'm on a computer that doesn't have outlook, so I'm winging this a little bit from memory and I can't test right now, but if you have any issues with it just leave a comment and I'll try to help out some more in the morning.
I'm running a report that gets distributed via email. In the email is a hyperlink to the report and a range of cells copied out of it as a snapshot of the report content. I'm trying to automate and found some VBA, but I'm not a programmer and can't modify it for my needs.
The VBA below gets me most of the way, but for 2 shortcomings:
1) I need the hyperlink to point to the specific file I'm referencing in the email, which changes daily (i.e. a unique workbook is created). The below uses a static hyperlink. I was trying to figure out a way to derive the hyperlink from a cell reference.
2) When copying the hyperlink and range of cells from excel into the email, I need the cells below the hyperlink. The below puts the range above the hyperlink.
I'd like to preserve the approach taken in the below VBA of referencing a worksheet to derive the email. It appears easy to deploy on other reports which get distributed.
Sub CreateMail()
Dim rngSubject As Range
Dim rngTo As Range
Dim rngCc As Range
Dim rngBody As Range
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With ActiveSheet
Set rngTo = .Range("B1")
Set rngCc = .Range("B3")
Set rngSubject = .Range("B2")
Set rngBody = .Range("H6:K22")
End With
rngBody.Copy
With objMail
.Body = "Please click on the link below..." & vbCrLf & "rngBody.Paste" & vbCrLf & _
"file:\\dbd03\nccode\Router_Proc\04Routing.txt"
End With
With objMail
.To = rngTo
.Cc = rngCc
.Subject = rngSubject
.Display
End With
SendKeys "^({v})", True
Set objOutlook = Nothing
Set objMail = Nothing
1) To make the file link dynamic, you can just include the reference of the cell, containing the file name, in the file path.
"<file:\\dbd03\nccode\Router_Proc\" & _
ActiveSheet.Range(<cell address here>) & ">"
Note: You might want to also check to make sure the path exists (like this) before putting it in the email
2) To paste the cells below the hyperlink, you can use another SendKeys combination to simulate the pressing of Ctrl + End, which will place the cursor at the end of the email. Doing this before using SendKeys to simulate the Ctrl + V should paste the range of cells after your body text. Your updated code should be the following:
With objMail
.To = rngTo
.Cc = rngCc
.Subject = rngSubject
.Display
End With
SendKeys "^({END})", True '<--- Add this line HERE
SendKeys "^({v})", True
Another Note: Also, i don't think you need "rngBody.Paste" in your Body string, as this just pastes that exact text in your email body