excel 为Outlook启用具有特定日期的自动回复

gj3fmq9x  于 2023-05-19  发布在  其他
关注(0)|答案(2)|浏览(134)

此VBA代码在Excel中。版本是Office 365。
引发的错误为
类型不匹配
在SetProperty xxxxx0X661E001F和0x661F0040中。
我尝试将strMessge更改为variant或更改为UNICODE。

Option Explicit

Sub SetAutoReply()

    Dim objOutlook As Outlook.Application
    Dim objNamespace As Outlook.Namespace
    Dim objStore As Outlook.Store
    Dim objPropertyAccessor As Outlook.propertyAccessor
    Dim strStartDate As String, strEndDate As String
    Dim dtStartDate As Date, dtEndDate As Date
    Dim strMessage As String

    ' Set the auto-reply start and end dates and times
    dtStartDate = "05/16/2023 08:00:00" ' Set the start date and time (MM/DD/YYYY HH:MM:SS)
    dtEndDate = "05/16/2023 17:00:00" ' Set the end date and time (MM/DD/YYYY HH:MM:SS)
    strMessage = "I am currently out of the office and will return on [end_date]."

    ' Initialize Outlook
    On Error Resume Next
    Set objOutlook = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set objOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

    ' Get the default mailbox
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objStore = objNamespace.DefaultStore
    Set objPropertyAccessor = objStore.PropertyAccessor

    ' Set the auto-reply settings
    With objPropertyAccessor
        strStartDate = Format(dtStartDate, "yyyy-mm-dd\THH:MM:ss")
        strEndDate = Format(dtEndDate, "yyyy-mm-dd\THH:MM:ss")
        .SetProperty "http://schemas.microsoft.com/mapi/proptag/0x661D000B", True 'Enable auto-reply
        .SetProperty "http://schemas.microsoft.com/mapi/proptag/0x661E001F", strMessage 'Set auto-reply message
        .SetProperty "http://schemas.microsoft.com/mapi/proptag/0x661F0040", strStartDate 'Set auto-reply start date
        .SetProperty "http://schemas.microsoft.com/mapi/proptag/0x66230040", strEndDate 'Set auto-reply end date
    End With

    ' Release the objects
    Set objPropertyAccessor = Nothing
    Set objStore = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing

    MsgBox "Auto-reply has been set from " & dtStartDate & " to " & dtEndDate & ".", vbInformation, "Auto-reply Set"

End Sub
nuypyhwy

nuypyhwy1#

最后两个属性(0x661F00400x66230040)是PT_SYSTIME类型(0x0040),因此必须传递DateTime值,而不是字符串。您有责任将数据转换为正确的类型。在这种情况下,使用CDate函数:

.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x661F0040", CDate(strStartDate) 'Set auto-reply start date
.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x66230040", CDate(strEndDate) 'Set auto-reply end date

如果要设置OOF状态和范围,请记住不能使用MAPI进行设置,需要使用EWS进行设置。

qyyhg6bp

qyyhg6bp2#

Outlook可能会使用PropertyAccessor.SetProperty方法在设置低级属性时应用自己的 * 业务规则 *。设置属性失败的情况包括:

  • 该属性是只读的,因为某些Outlook和MAPI属性是只读的。
  • 找不到指定命名空间引用的属性。
  • 指定的属性格式无效,无法分析。
  • 属性不存在,无法创建。
  • 属性存在,但传递的值的类型不正确。
  • 无法打开属性,因为客户端脱机。
  • 该属性是使用UserProperties.Add方法创建的。第一次设置属性时,必须使用UserProperty.Value属性,而不是PropertyAccessor对象的SetPropertiesSetProperty方法。

因此,正如您所看到的,代码可能失败的原因太多了。我建议使用任何低级属性浏览器工具,如MFCMAPIOutlookSpy,并尝试手动设置这些属性,以确保您试图分配的值有效。如果它们是有效的,我建议使用VBA来确保SetProperty可以用于此。

相关问题