使用VBA / Excel在Outlook中的公共日歷中進行預約

Question

我只是想知道是否有人可以幫助我。 我對編碼非常陌生，正在嘗試創建一個宏，以在共享Outlook日歷中預訂全天活動。 我搜索了互聯網的深度，似乎找不到任何東西。

我正在嘗試使用下面的代碼來提取工作簿中某個范圍的起止日期和截止日期，並將其預訂到Outlook中的以下共享日歷“ \\ UK Public Folders \\ Customer Services \\ UK Customer Services Calendar”中，但是我只是沒有定義文件夾路徑的運氣。 有人可以幫忙嗎？

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

任何幫助將不勝感激

非常感謝

傑米

Answer 1

錯誤代碼或錯誤消息是什么？ 您是否使用On Error Resume Next隱藏錯誤消息？ 不要！