VBA Code Bank : Create appointment in outlook calendar for different time zones

Three factors affect the scheduling of a meeting in Outlook:

  1. The computer’s clock setting (time).
  2. The computer’s local time zone setting, which consists of an offset value to Greenwich mean time (GMT).
  3. The computer’s daylight-saving time adjustment setting.

All three factors must be correct on both the meeting requestor’s computer and on each attendee’s computer. Otherwise, Outlook cannot schedule the meeting time correctly.

Try the below code to create the appointment in outlook for different time zones and let me know your feedback.

Dim timezonestart As Variant, timezoneend As Variant

i = 2
Do Until Trim(Cells(i, 1).Value) = “”

timezonestart = Cells(i, 12)
timezoneend = Cells(i, 13)
Set tzStart = olApp.TimeZones.Item(timezonestart)
Set tzEnd = olApp.TimeZones.Item(timezoneend)

Option Explicit
Public Sub CreateOutlookApptTZ()
Sheets(“Sheet1”).Select
‘ On Error GoTo Err_Execute

Dim olApp As Outlook.Application
Dim olAppt As Outlook.AppointmentItem
Dim blnCreated As Boolean
Dim olNs As Outlook.Namespace
Dim CalFolder As Outlook.MAPIFolder
Dim arrCal As String
Dim tzStart As TimeZone, tzEnd As TimeZone

Dim i As Long

On Error Resume Next

Set olApp = Outlook.Application
Set tzStart = olApp.TimeZones.Item(“Eastern Standard Time”)
Set tzEnd = olApp.TimeZones.Item(“UTC”)

If olApp Is Nothing Then
Set olApp = Outlook.Application
blnCreated = True
Err.Clear
Else
blnCreated = False
End If

On Error GoTo 0

Set olNs = olApp.GetNamespace(“MAPI”)
Set CalFolder = olNs.GetDefaultFolder(olFolderCalendar)

i = 2
Do Until Trim(Cells(i, 1).Value) = “”

Set olAppt = CalFolder.Items.Add(olAppointmentItem)

With olAppt

‘Define calendar item properties
.StartTimeZone = tzStart
.Start = Cells(i, 6) + Cells(i, 7) ‘+ TimeValue(“9:00:00”)
.EndTimeZone = tzEnd
.End = Cells(i, 8) + Cells(i, 9) ‘+TimeValue(“10:00:00”)
.Subject = Cells(i, 2)
.Location = Cells(i, 3)
.Body = Cells(i, 4)
.BusyStatus = olBusy
.ReminderMinutesBeforeStart = Cells(i, 10)
.ReminderSet = True
.Categories = Cells(i, 5)
.Save

End With

i = i + 1
Loop
Set olAppt = Nothing
Set olApp = Nothing

Exit Sub

Err_Execute:
MsgBox “An error occurred – Exporting items to Calendar.”

End Sub

 

Find out extensive VBA Programming Course here, and learn to automate your Excel reports, Connect Excel to third-party applications and develop sophisticated Business Applications.

Happy Excelling

Team Excelgoodies

Leave a Reply

Your email address will not be published. Required fields are marked *