如何为VBA创建的Outlook日程预约设置指定时区？

你可以通过Outlook VBA内置的StartTimeZone和EndTimeZone属性设置预约的时区，无需修改系统全局时区，操作方法如下：

• 调用Application.TimeZones.Item()方法获取目标时区对象，参数为目标时区的标准名称，比如西雅图对应的太平洋时区标准名称为Pacific Standard Time，中国东八区对应名称为China Standard Time
• 将预约对象的StartTimeZone和EndTimeZone属性统一赋值为你获取的目标时区对象即可

另外你原代码中ReminderMinutesBeforeStart属性需要传入整数类型的分钟数，不要用TimeValue，否则会出现提醒时间计算错误的问题，修正后的完整代码如下：

Sub Outlook_Appointment()
Dim o As Outlook.Application
Set o = New Outlook.Application

Dim ONS As Outlook.Namespace
Set ONS = o.GetNamespace("MAPI")

Dim CAL_FOL As Outlook.Folder
Set CAL_FOL = ONS.GetDefaultFolder(olFolderCalendar)

Dim myapt As Outlook.AppointmentItem
Set myapt = CAL_FOL.Items.Add(olAppointmentItem)

' 新增：获取目标时区对象，这里以西雅图对应的太平洋时区为例
Dim targetTimeZone As Outlook.TimeZone
Set targetTimeZone = o.TimeZones.Item("Pacific Standard Time")
' 如果要设为中国时区，替换为以下代码
' Set targetTimeZone = o.TimeZones.Item("China Standard Time")

With myapt
    ' 先设置时区，再设置起止时间，避免时间自动偏移
    .StartTimeZone = targetTimeZone
    .EndTimeZone = targetTimeZone
    
    .Display
    .Start = Date + TimeValue("15:30:00")
    .End = Date + TimeValue("16:30:00")
    .Location = "Seattle"
    .Subject = "Discussion"
    .Body = "This is a test mail to block the calendar"
    ' 修正：提醒提前15分钟，直接传入整数15即可
    .ReminderMinutesBeforeStart = 15
    .To = "abc@gmail.com"
    .Save
End With
End Sub

补充注意事项：

• 请务必先设置时区属性，再赋值Start和End时间，否则Outlook会先按本地时区解析时间，切换时区时会出现非预期的时间偏移
• 如果需要查看系统支持的所有时区名称，可以遍历o.TimeZones集合打印所有时区的StandardName属性

内容的提问来源于stack exchange，提问作者Micheal