使用VBA在Excel中搜索约会 [英] Search Appointments in excel with VBA

问题描述

我正在尝试编写一个脚本，以读取我的Excel工作表，并将日期与Outlook中的约会日期进行比较.

Im trying to code a script that read my excel sheets and compare the date with the date of appointments in Outlook.

我不知道为什么我的代码没有找到任何OLAppointment项来将其日期与工作表上的dte进行比较...

I dont know why my code dont find any OLAppointment Item to compare their date with my dte on the sheet...

请参见下面的代码

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"显示通过以下方式找到的约会的属性:

I have an appointment created on the calendar "aa" on 23/11/2013 but when i try to search it with my macro always give me "appointment not found". Also ive tried to show with "Msgbox" the properties of the appointments found with:

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

但无论如何都不要走:\

but dont go anyway :\

为我可怜的英语感到抱歉.

Sry for my poor english.

推荐答案

问题是您没有定义OLAppointment是什么.由于这是Excel中的宏，因此您需要定义Outlook内部常量.

The issue is that you did not define what OLAppointment is. Since this is macro in Excel, you need to define Outlook internal constants.

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

您的代码可以正常工作，并在默认的Calendar下使用名为aa的日历进行了测试.

Your code works, tested with calendar named aa under the default Calendar.

这篇关于使用VBA在Excel中搜索约会的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！