0

Excel シートを読み取り、日付を Outlook の予定の日付と比較するスクリプトをコーディングしようとしています。

私のコードがOLAppointmentアイテムを見つけて、シート上の私のdteと日付を比較できない理由がわかりません...

以下のコードを参照してください

Public Function CheckAppointment(ByVal argCheckDate As Date) As Boolean

    Dim oApp As Object
    Dim oNameSpace As Object
    Dim oApptItem As Object
    Dim oFolder As Object
    Dim oMeetingoApptItem As Object
    Dim oObject As Object
    On Error Resume Next

    Set oApp = GetObject(, "Outlook.Application")
    If oApp Is Nothing Then Set oApp = CreateObject("Outlook.Application")

    Set oNameSpace = oApp.GetNamespace("MAPI")
    Set oFolder = oNameSpace.Session.GetDefaultFolder(9).Folders("aa")
    CheckAppointment = False
    For Each oObject In oFolder.Items
    MsgBox oObject
    If (oObject.Class = OLAppointment) Then
      Set oApptItem = oObject
        If oApptItem.Start = argCheckDate Then
            CheckAppointment = True
        End If
      End If
    Next oObject

    Set oApp = Nothing
    Set oNameSpace = Nothing
    Set oApptItem = Nothing
    Set oFolder = Nothing
    Set oObject = Nothing

End Function

Public Sub Driver()

    Dim dtCheck As Date
    Dim sbCheck As String

    dtCheck = DateValue("23/11/2013") + TimeValue("09:00:00")


    If CheckAppointment(dtCheck) Then
        MsgBox "Appointment found", vbOKOnly + vbInformation
    Else
        MsgBox "Appointment not found", vbOKOnly + vbExclamation
    End If

End Sub

2013 年 11 月 23 日にカレンダー "aa" で作成された予定がありますが、マクロで検索しようとすると、常に "予定が見つかりません" と表示されます。また、「Msgbox」で見つかった予定のプロパティを表示しようとしました：

Set oFolder = oNameSpace.Session.GetDefaultFolder(9).Folders("aa")
CheckAppointment = False
For Each oObject In oFolder.Items
MsgBox oObject.Subject

とにかく行かないでください:\

私の下手な英語をおねがいします。

4

1 に答える 1

0

問題は、何が何であるかを定義していないことOLAppointmentです。これは Excel のマクロであるため、Outlook の内部定数を定義する必要があります。

Public Function CheckAppointment(ByVal argCheckDate As Date) As Boolean

    Const olAppointment = 26 ' <== Added this line and your code worked.
    Dim oApp As Object
    Dim oNameSpace As Object
    Dim oApptItem As Object
    Dim oFolder As Object
    Dim oMeetingoApptItem As Object
    Dim oObject As Object
    On Error Resume Next ' No appointment was found since you have this line and olAppointmnet wasn't defined.

    Set oApp = GetObject(, "Outlook.Application")
    If oApp Is Nothing Then Set oApp = CreateObject("Outlook.Application")

    Set oNameSpace = oApp.GetNamespace("MAPI")
    Set oFolder = oNameSpace.Session.GetDefaultFolder(9).Folders("aa")
    CheckAppointment = False
    For Each oObject In oFolder.Items
        MsgBox oObject
        If (oObject.Class = olAppointment) Then ' <== This is why you need to define it first
            Set oApptItem = oObject
            If oApptItem.Start = argCheckDate Then
                CheckAppointment = True
                Exit For ' <== Added this exit for loop to improve performance
            End If
        End If
    Next oObject

    Set oApp = Nothing
    Set oNameSpace = Nothing
    Set oApptItem = Nothing
    Set oFolder = Nothing
    Set oObject = Nothing
End Function

Public Sub Driver()
    Dim dtCheck As Date
    Dim sbCheck As String

    dtCheck = DateValue("4/11/2013") + TimeValue("09:00:00")
    If CheckAppointment(dtCheck) Then
        MsgBox "Appointment found", vbOKOnly + vbInformation
    Else
        MsgBox "Appointment not found", vbOKOnly + vbExclamation
    End If
End Sub

あなたのコードは動作aaし、デフォルトで名前が付けられたカレンダーでテストされていますCalendar。

于 2013-11-04T05:37:17.537 に答える