使用VBA / Excel在Outlook中的公共日历中进行预约

Question

I was just wondering if anyone can help me. I am very new to coding and am trying to create a macro that books full day events in a shared outlook calendar. I have searched the depths of the internet and cant seem to find anything.

I am trying to use the below code which picks up the from and to date in a range on the work book and book into the following shared calendar "\\UK Public Folders\\Customer Services\\UK Customer Services Calendar" in outlook but I am just not having any luck defining the folder path. can anyone help?

Option Explicit

Sub CreateOutlookAppointment()

Dim strCategory As String, strTopic As String, strLocation As String, strStartdate As String, strStarttime As String
Dim strEnddate As String, strEndtime As String, strDuration As String, bolWholeday As Boolean, bolReminder As Boolean, lngReminderMinutes As Long
Dim bolPlaysound As Boolean, strParticipants As String, bolRespondNecessary As Boolean, strNote As String


Dim strCategory As String, strTopic As String, strLocation As String, strStartdate As String, strStarttime As String
Dim strEnddate As String, strEndtime As String, strDuration As String, bolWholeday As Boolean, bolReminder As Boolean, lngReminderMinutes As Long
Dim bolPlaysound As Boolean, strParticipants As String, bolRespondNecessary As Boolean, strNote As String

Dim olApp As Object
Dim objCal As Object
Dim olCal As Object

Set olApp = CreateObject("Outlook.Application")
Set objCal = olApp.Session.GetDefaultFolder(9)
Set olCal = objCal.Items.Add(1)



'=============================================================
'Entries for appointment
'=============================================================
strCategory = "Holiday"
strTopic = Range("Employee3")
strLocation = ""
strStartdate = Range("FROM1")
strStarttime = "09:00"
strEnddate = Range("FROM2")
strEndtime = "09:00"
strDuration = "60"    'If duration of appointment necessary, remove comment for "Duration" below
bolWholeday = True
bolReminder = True
lngReminderMinutes = 10
bolPlaysound = True
strParticipants = Range("A8").Value
bolRespondNecessary = False
strNote = "Your On Holiday"
'=============================================================

'Create appointment
With olCal
    .Categories = strCategory
    .Subject = strTopic
    .Location = strLocation
    .Start = strStartdate & " " & strStarttime
    .End = strEnddate & " " & strEndtime
    '.Duration = strDuration   'If duration is given about, remove comment
    .AllDayEvent = bolWholeday
    .ReminderSet = bolReminder
    .ReminderMinutesBeforeStart = lngReminderMinutes
    .ReminderPlaySound = bolPlaysound
    .Recipients.Add strParticipants
    .ResponseRequested = bolRespondNecessary
    .Body = strNote
    .Display
End With

On Error Resume Next
Set olCal = Nothing
Set olApp = Nothing

End Sub

any help would be greatly appreciated

many thanks

Jamie

Answer 1

What is the error code or error message? Are you using On Error Resume Next to hide error messages? Do not!