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

 

[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​

[TABLE="class: head"]
<tbody>[TR="bgcolor: #FFFFFF"]
[TD]

Site​

[/TD]
[TD]

Email​

[/TD]
[TD]

Date​

[/TD]
[TD]

Time​

[/TD]
[TD]

Address​

[/TD]
[TD]

Time Zone​

[/TD]
[TD]

Area​

[/TD]
[TD]

Area Manager​

[/TD]
[TD]

Region Manager​

[/TD]
[TD]

Director​

[/TD]
[TD]

Subject​

[/TD]
[TD]

Email Sent Verification​

[/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD]

5​

[/TD]
[TD]

Site5@email.com​

[/TD]
[TD]

8/1/2017​

[/TD]
[TD]

12:00 pm​

[/TD]
[TD]

123 Happy St​

[/TD]
[TD]

CST​

[/TD]
[TD]

100​

[/TD]
[TD]

areamanager1@email.com​

[/TD]
[TD]

regionm1@email.com​

[/TD]
[TD]

director1@email.com​

[/TD]
[TD="bgcolor: #FFFF00"]

Leave​

[/TD]
[TD][/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD]

10​

[/TD]
[TD]

Site10@email.com​

[/TD]
[TD]

8/1/2017​

[/TD]
[TD]

6:00 am​

[/TD]
[TD]

12 Lonely Ave​

[/TD]
[TD]

EST​

[/TD]
[TD]

100​

[/TD]
[TD]

areamanager2@email.com​

[/TD]
[TD]

regionm2@email.com​

[/TD]
[TD]

director2@email.com​

[/TD]
[TD="bgcolor: #FFFF00"]

This​

[/TD]
[TD][/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD]

12​

[/TD]
[TD]

Site12@email.com​

[/TD]
[TD]

8/4/2017​

[/TD]
[TD]

6:00 m​

[/TD]
[TD]

3 Snippy Dr​

[/TD]
[TD]

CST​

[/TD]
[TD]

100​

[/TD]
[TD]

areamanager3@email.com​

[/TD]
[TD]

regionm1@email.com​

[/TD]
[TD]

director1@email.com​

[/TD]
[TD="bgcolor: #FFFF00"]

Column​

[/TD]
[TD][/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD]

15​

[/TD]
[TD]

Site15@email.com​

[/TD]
[TD]

8/5/2017​

[/TD]
[TD]

12:00 pm​

[/TD]
[TD]

4 Old Farm​

[/TD]
[TD]

EST​

[/TD]
[TD]

200​

[/TD]
[TD]

areamanager4@email.com​

[/TD]
[TD]

regionm1@email.com​

[/TD]
[TD]

director1@email.com​

[/TD]
[TD="bgcolor: #FFFF00"]

Blank​

[/TD]
[TD][/TD]
[/TR]
[TR="bgcolor: #FFFFFF"]
[TD]

18​

[/TD]
[TD]

Site18@email.com​

[/TD]
[TD]

8/1/2017​

[/TD]
[TD]

6:00 am​

[/TD]
[TD]

5 Nowhere St​

[/TD]
[TD]

CST​

[/TD]
[TD]

200​

[/TD]
[TD]

areamanager5@email.com​

[/TD]
[TD]

regionm2@email.com​

[/TD]
[TD]

director2@email.com​

[/TD]
[TD="bgcolor: #FFFF00"][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
​

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]