Question

我只是想知道是否有人可以帮助我。我是编码的新手，我正在尝试创建一个宏，用于在共享的Outlook日历中预订全天活动。我搜索了互联网的深度，似乎找不到任何东西。

我正在尝试使用以下代码来获取工作簿范围内的起始日期并预订到以下共享日历＆＃34; \ UK Public Folders \ Customer Services \ UK Customer Services Calendar＆＃ 34;在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

任何帮助将不胜感激

非常感谢

杰基

Answer 1

错误代码或错误消息是什么？您是否正在使用 On Error Resume Next 来隐藏错误消息？不要！

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

1 个答案: