jidery
06-12-2018, 07:43 AM
Hello,
I am tasked with updating our companies macros in one of our excel files we use daily.
We have currently have it set up with excel fields, and a button that sends that data to an outlook calendar which it figured out using "arrCal".
Code below:
Option ExplicitPublic Sub CreateOutlookApptz()
Sheets("Macros").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 subFolder As Outlook.MAPIFolder
Dim arrCal As String
Dim i As Long
On Error Resume Next
Set olApp = Outlook.Application
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 = 3
Do Until Trim(Cells(i, 1).Value) = ""
arrCal = Cells(i, 1).Value
Set subFolder = CalFolder.Folders(arrCal)
If Trim(Cells(i, 11).Value) = "True" Then
Set olAppt = subFolder.Items.Add(olAppointmentItem)
'MsgBox subFolder, vbOKCancel, "Folder Name"
With olAppt
'Define calendar item properties
.Start = Cells(i, 6) + Cells(i, 7)
.End = Cells(i, 8) + Cells(i, 9)
.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
End If
i = i + 1
Loop
Set olAppt = Nothing
Set olApp = Nothing
ThisWorkbook.Save
Exit Sub
Err_Execute:
MsgBox "An error occurred - Exporting items to Calendar."
End Sub
The goal is to have this button sync with an exchange calendar so multiple people in our organization can all send these events to one centralized calendar.
I tried to follow some guides that attempt to accomplish a similar task but I haven't had any luck as most the guides I find reference the default calendar of a specific person.
Any ideas how to set arrCal to reference a specific exchange calendar? I have the hosts domain/email and also the calendar name.
I am tasked with updating our companies macros in one of our excel files we use daily.
We have currently have it set up with excel fields, and a button that sends that data to an outlook calendar which it figured out using "arrCal".
Code below:
Option ExplicitPublic Sub CreateOutlookApptz()
Sheets("Macros").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 subFolder As Outlook.MAPIFolder
Dim arrCal As String
Dim i As Long
On Error Resume Next
Set olApp = Outlook.Application
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 = 3
Do Until Trim(Cells(i, 1).Value) = ""
arrCal = Cells(i, 1).Value
Set subFolder = CalFolder.Folders(arrCal)
If Trim(Cells(i, 11).Value) = "True" Then
Set olAppt = subFolder.Items.Add(olAppointmentItem)
'MsgBox subFolder, vbOKCancel, "Folder Name"
With olAppt
'Define calendar item properties
.Start = Cells(i, 6) + Cells(i, 7)
.End = Cells(i, 8) + Cells(i, 9)
.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
End If
i = i + 1
Loop
Set olAppt = Nothing
Set olApp = Nothing
ThisWorkbook.Save
Exit Sub
Err_Execute:
MsgBox "An error occurred - Exporting items to Calendar."
End Sub
The goal is to have this button sync with an exchange calendar so multiple people in our organization can all send these events to one centralized calendar.
I tried to follow some guides that attempt to accomplish a similar task but I haven't had any luck as most the guides I find reference the default calendar of a specific person.
Any ideas how to set arrCal to reference a specific exchange calendar? I have the hosts domain/email and also the calendar name.