I have been trying to write a code but with no avail for the following problem:
I have a set of people who use a database. So everyone puts the time of the day for which they want to use it for e.g.:
Team member Time mail ID
ABC 1 pm - 2 pm ABC#de.com
XYZ 3 pm - 4 pm YXV#de.com
I want that if ABC finishes his work before 2 i.e. at 1:30 pm and if he updates the same on the sheet which is on the server and saves it, the next person due to use the database gets a mail stating that he has that extra 30 mins for the same.
Also, even if ABC finishes on time only i.e. at 2 XYZ should be able to get a reminder of his turn.
Another situation can be if ABC extend his session in the excel, XYZ gets a due indication in mail of the same in order to check and change his time slot.
I don't want everyone on the list to get the e-mail, only the person next in que.
Thanks in advance.
Sats
1) Please add the spreadsheet you are working with so far, as others may be able to provide you with more direction.
2) Here is code snippet to send email via vba in excel to someone; it uses outlook on users desktop to send email.
Sub SendEmail(ByVal strTo as string, ByVal strCC as string, ByVal strSubject As String, ByVal strBody As String, Optional ByVal strHTMLBody As String = "")
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 = strTo
.CC = strCC
.subject = strSubject
If strBody <> "" Then
.body = strBody
Else
.HTMLBody = strHTMLBody
End If
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
'.Send ' if you want to send immediately
.Display ' if you want the user to see the email before sending it manually.
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
3) Defining the workflow will require some additional VBA programming which depends on how you have your spreadsheet setup.
Hope this helps.
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
When I send an assignment to students, I create an individualized file I want each student to work on. I generate the files using VBA and Excel.
I put Outlook in "Work Offline" mode so I can make sure the e-mails have the correct attachments before I put Outlook back online. I usually then hit the "send/receive all folders" button so they'll go out immediately while I'm watching.
This works at work where I have Outlook configured with just my work e-mail.
On Outlook at home (the installed app on a Windows 10 machine), I have two accounts configured.
Account #1 is a personal e-mail from a personal domain.
Account #2 is my e-mail account for work.
I want to generate e-mails like I do at work, and for them to go in the outbucket of my work account. I would then send them from there.
However, they go into the outbucket of my personal account. I don't want students to get an e-mail from an unrecognized sender. Nor do I want them replying to those e-mails.
The code to create e-mails:
Sub makemail()
Dim strLocation As String
Dim OutApp As Object
Dim OutMail As Object
Dim OutAccount As Object
Range("a1").Activate
eaddy = ActiveCell.Offset(0, 4).Value 'student's e-mail address in a worksheet
IndivFile = ActiveCell.Offset(0, 8).Value 'this is an identifier for the student's individual file
LastName = ActiveCell.Offset(0, 1).Value ' student's last name
Do Until ActiveCell.Value = ""
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set OutAccount = OutApp.Session.Accounts.Item(1)
On Error Resume Next
With OutMail
.To = eaddy
.CC = ""
.BCC = ""
.Subject = LastName & " (text that describes the assignment)"
.Body = "(body of message)"
strLocation = "(location of the individual attachments" & IndivFile & ".xlsx"
.Attachments.Add (strLocation)
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Set OutAccount = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveCell.Offset(1, 0).Activate
eaddy = ActiveCell.Offset(0, 4).Value
IndivFile = ActiveCell.Offset(0, 8).Value
LastName = ActiveCell.Offset(0, 1).Value
Loop
End Sub
It dumps the generated e-mails into the outbucket of account #1: my personal account.
I tried replacing .Send with .SendUsingAccount = OutApp.Session.Accounts.Item(2)
Putting anything in the parentheses (including a 0 or 1) will mean I don't see the output in either outbucket. (No idea if the e-mails even generated. they're probably sitting in some directory I haven't looked in.)
So, I just generated all the e-mails and they showed up in my personal account's outbucket.
I selected them all and dropped them into the outbucket of my work account.
I clicked the "send/receive" and they won't go anywhere.
If I open each e-mail individually and click the "send" button in the e-mail, they go. I see them in my sent folder.
I don't know that much about Outlook. I wonder if this is some sort of mismatched certificate problem on the e-mails? But if that were the case, why don't they go in bulk, but will go if sent individually with the e-mail open?
I just tested. if the e-mails are marked read or unread, it makes no difference.
I did set my work-email as the primary in Outlook (File > Account Settings > Designate one account as the primary one.
My questions:
Is there a way, code-wise, to put this in the second account's outbucket (work)?
Keep in mind that .SendUsingAccount = OutApp.Session.Accounts.Item(2) did not work.
If I can't do that, is there a way to change my e-mail accounts so the work one is #1?
Other than deleting and re-installing in a specific order?
I did go in and make the work-email my primary e-mail.
Why won't they send in one outbucket (because they were dragged and dropped from another outbucket), but will send if you open them individually?
It seems you just need to set/change the default account in Outlook.
See How To Set An Email Account As The Default Account In Outlook? for more information.
Also, you can use the SendUsingAccount property of Outlook items which sets an Account object that represents the account under which the MailItem is to be sent. The SendUsingAccount property can be used to specify the account that should be used to send the MailItem when the Send method is called.
Sub SendEmailFromAccount(ByVal application As Outlook.Application, _
ByVal subject As String, ByVal body As String, ByVal recipients As String, ByVal smtpAddress As String)
' Create a new MailItem and set the To, Subject and Body properties.
Dim newMail As Outlook.MailItem = DirectCast(application.CreateItem(Outlook.OlItemType.olMailItem), Outlook.MailItem)
newMail.To = recipients
newMail.Subject = subject
newMail.Body = body
' Retrieve the account that has the specific SMTP address.
Dim account As Outlook.Account = GetAccountForEmailAddress(application, smtpAddress)
' Use this account to send the email.
newMail.SendUsingAccount = account
newMail.Send()
End Sub
Function GetAccountForEmailAddress(ByVal application As Outlook.Application, ByVal smtpAddress As String) As Outlook.Account
' Loop over the Accounts collection of the current Outlook session.
Dim accounts As Outlook.Accounts = application.Session.Accounts
Dim account As Outlook.Account
For Each account In accounts
' When the email address matches, return the account.
If account.SmtpAddress = smtpAddress Then
Return account
End If
Next
End Function
Okay, found it out. Part of it depended on going to Tools > References and then making sure I've got Microsoft Outlook 16.0 Object Library is selected. Granted, you can do this without early bindings, but it seemed to help.
Here is the code I eventually came up with:
Sub makemail()
Range("a1").Activate
eaddy = ActiveCell.Offset(0, 4).Value
IndivFile = ActiveCell.Offset(0, 8).Value
LastName = ActiveCell.Offset(0, 1).Value
Dim objOutlook As Object
Dim objMail As Object
Worksheets("Rollcall").Activate
Set objOutlook = CreateObject("Outlook.Application")
Dim oAccount As Outlook.Account
Set oAccount = Outlook.Application.Session.Accounts(1)
Debug.Print oAccount
If oAccount = "outlook account you want to use" Then
Debug.Print ("condition true")
'Main Logic ============================================
Do Until ActiveCell.Value = ""
Set objMail = objOutlook.CreateItem(0)
On Error Resume Next
With objMail
.To = eaddy
'.CC = ""
'.BCC = ""
.Subject = (your subject)
.Body = "your outgoing message"
strLocation = "(location of attachment"
.Attachments.Add (strLocation)
Set .SendUsingAccount = oAccount
.Send
End With
Set objMail = Nothing
ActiveCell.Offset(1, 0).Activate
eaddy = ActiveCell.Offset(0, 4).Value
IndivFile = ActiveCell.Offset(0, 8).Value
LastName = ActiveCell.Offset(0, 1).Value
Loop
Set objOutlook = Nothing
End If
End Sub
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 am using MS Excel and Outlook 2013. I am trying to automate an Excel spreadsheet that sends 5 emails to a specified address using Outlook.
The trick is I want each message to display one at a time and only move on to the next message when the user either hits Send or closes the message. Here is what I have so far:
Sub Send_Emails()
Dim OutApp As Object: Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object: Set OutMail = OutApp.CreateItem(0)
'Send Email
With OutMail
.to = "john.doe#mycompany.com"
.Subject = "This is the Subject"
.Body = "This is message"
.Display
End With
On Error Resume Next:
OutMail = Nothing
OutApp = Nothing
End Sub
Sub Send_Five_Emails()
For i = 1 To 5 'Send email 5 times
Call Send_Emails
Next i
End Sub
The problem with this code is that it displays all 5 message windows at once. Is there a way to make the Close event of one message window trigger the Displaying of the next one, so as to make them appear one at a time?
I appreciate the help.
Use .Display (True)
The expression.Display(Modal) argument is used with all objects except for the Explorer and MAPIFolder objects, True to make the window modal. The default value is False.
See Display Method on MSDN
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.