VBA Code to send mass Outlook invites

[sycodiz]

I am trying to write a code to send Outlook meeting invites based on what I have in a spread sheet. I am missing several key points in the code so decided to see if anyone out there can develop one that works better than the mess I created.

Below is the type of spread sheet I will be using.

The invites will need to go to those in columns B, H, I, and J
The invites must go through another calendar called "Audit Calendar"- not my default
All audits will need a 1 week reminder
There are 2 different time zones that will need to be coded for
I would like to add a body to the email, which will be the same for every email except I would like the header to say what the subject line is.
As you can see by the subject line, I would like to use the date and time from the excel sheet
the data will be a lot longer than the example I show below.

Any help would be greatly appreciated!

	A	B	C	D	E	F	G	H	I	J	K
1	Site	Email	Date	Tiime	Address	Time Zone	Area	Area Manager	Region Manager	Director	Subject
2	5	Site5@email.com	8/2/2017	12:00	123 Happy St	CST	100	areamanager1@email.com	regionm1@email.com	director1@email.com	You are scheduled for an audit on [C2] at [D2]
3	10	Site10@email.com	8/3/2017	06:00	12 Lonely Ave	EST	100	areamanager2@email.com	regionm2@email.com	director2@email.com	You are scheduled for an audit on [C3] at [D3]
4	12	Site12@email.com	8/4/2017	06:00	3 Snippy Dr	CST	100	areamanager3@email.com	regionm1@email.com	director1@email.com	You are scheduled for an audit on [C4] at [D4]
5	15	Site15@email.com	8/5/2017	12:00	4 Old Farm	EST	200	areamanager4@email.com	regionm1@email.com	director1@email.com	You are scheduled for an audit on [C5] at [D5]
6	18	Site18@email.com	8/6/2017	06:00	5 Nowhere St	CST	200	areamanager5@email.com	regionm2@email.com	director2@email.com	You are scheduled for an audit on [C6] at [D6]
7

<tbody>
</tbody>

 

[igold]

Hi,

There is a ton of information on this page. Perhaps you can re-write your code taking advantage of the information provided here:

Mail from Excel with Outlook (VBA)

I hope this helps.

 

[sycodiz]

Thanks but that is mostly for just sending an email, I am looking to send out meeting invites.

 

[Logit]

.
This macro is to be pasted into a Routine Module :

Option Explicit


Sub emailall()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList, CCList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp, OutMail


With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With


Sheets("Sheet1").Select
lRow = Cells(Rows.Count, 2).End(xlUp).Row


For i = 2 To lRow
  If Cells(i, 3).Value = Date + 7 Then
     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)


        toList = Cells(i, 2)    'gets the recipient from col B
        CCList = Cells(i, 8) & ", " & Cells(i, 9) & ", " & Cells(i, 10)
        eSubject = "You are scheduled for an audit on " & Cells(i, 3) & " at " & Cells(i, 4) & " " & Cells(i, 6)
        eBody = "Greetings : " & vbCrLf & vbCrLf & "Scheduled audit is upcoming on the date indicated above."
        
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = CCList
        .BCC = ""
        .Subject = eSubject
        .Body = eBody
        '.bodyformat = 1
        .Display   ' ********* Creates draft emails. Comment this out when you are ready
        '.Send     '********** UN-comment this when you  are ready to go live
        End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 Cells(i, 12) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
End If
Next i


ActiveWorkbook.Save


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
Sheets("Sheet1").Range("A1").Select
End Sub

The above is based on this format :

A__________B__________C________D____________E_________F_____G___________H_______________I__________________J__________K__________L​

Site​	Email​	Date​	Time​	Address​	Time Zone​	Area​	Area Manager​	Region Manager​	Director​	Subject​	Email Sent Verification​
5​	Site5@email.com​	8/1/2017​	12:00 pm​	123 Happy St​	CST​	100​	areamanager1@email.com​	regionm1@email.com​	director1@email.com​	Leave​
10​	Site10@email.com​	8/1/2017​	6:00 am​	12 Lonely Ave​	EST​	100​	areamanager2@email.com​	regionm2@email.com​	director2@email.com​	This​
12​	Site12@email.com​	8/4/2017​	6:00 m​	3 Snippy Dr​	CST​	100​	areamanager3@email.com​	regionm1@email.com​	director1@email.com​	Column​
15​	Site15@email.com​	8/5/2017​	12:00 pm​	4 Old Farm​	EST​	200​	areamanager4@email.com​	regionm1@email.com​	director1@email.com​	Blank​
18​	Site18@email.com​	8/1/2017​	6:00 am​	5 Nowhere St​	CST​	200​	areamanager5@email.com​	regionm2@email.com​	director2@email.com​

<tbody>
</tbody>

​

Column K can be hidden if desired.

 

[LockeGarmin]

I noticed that this code might at least want to have this adjustment made.

Sub emailall()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList, CCList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp, OutMail


With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With


Sheets("Sheet1").Select
lRow = Cells(Rows.Count, 2).End(xlUp).Row

[COLOR=#ff0000]Set OutApp = CreateObject("Outlook.Application")[/COLOR]

For i = 2 To lRow
  If Cells(i, 3).Value = Date + 7 Then
     Set OutMail = OutApp.CreateItem(0)


        toList = Cells(i, 2)    'gets the recipient from col B
        CCList = Cells(i, 8) & ", " & Cells(i, 9) & ", " & Cells(i, 10)
        eSubject = "You are scheduled for an audit on " & Cells(i, 3) & " at " & Cells(i, 4) & " " & Cells(i, 6)
        eBody = "Greetings : " & vbCrLf & vbCrLf & "Scheduled audit is upcoming on the date indicated above."
        
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = CCList
        .BCC = ""
        .Subject = eSubject
        .Body = eBody
        '.bodyformat = 1
        .Display   ' ********* Creates draft emails. Comment this out when you are ready
        '.Send     '********** UN-comment this when you  are ready to go live
        End With
 
    On Error GoTo 0
    Set OutMail = Nothing
 Cells(i, 12) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
End If
Next i

[COLOR=#ff0000]Set OutApp = Nothing[/COLOR]

ActiveWorkbook.Save


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
Sheets("Sheet1").Range("A1").Select 
[COLOR=#333333]End Sub[/COLOR]