我只是想知道是否有人可以帮助我。我对编码非常陌生,正在尝试创建一个宏,用于在共享的 Outlook 日历中预订全天事件。我已经搜索了互联网的深处,似乎找不到任何东西。
我正在尝试使用以下代码,该代码在工作簿的某个范围内选取开始和结束日期,并在 Outlook 中预订到以下共享日历"\英国公共文件夹\客户服务\英国客户服务日历"中,但我只是没有任何运气定义文件夹路径。 谁能帮忙?
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
任何帮助将不胜感激
非常感谢
杰米
错误代码或错误消息是什么? 您是否使用"在下一个错误恢复时"来隐藏错误消息?不要!