用VBA在excel中搜索约会
我试图编写一个脚本,读取我的excel工作表,并将日期与Outlook中的约会日期进行比较 我不知道为什么我的代码找不到任何OLAppoiment项目来比较他们的日期和我的dte表上 请参见下面的代码用VBA在excel中搜索约会,excel,vba,outlook,Excel,Vba,Outlook,我试图编写一个脚本,读取我的excel工作表,并将日期与Outlook中的约会日期进行比较 我不知道为什么我的代码找不到任何OLAppoiment项目来比较他们的日期和我的dte表上 请参见下面的代码 Public Function CheckAppointment(ByVal argCheckDate As Date) As Boolean Dim oApp As Object Dim oNameSpace As Object Dim oApptItem As Obj
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
但无论如何不要去:\
我的英语很差。问题是你没有定义什么是
olappoimment
。因为这是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
公共函数CheckAppointment(ByVal argCheckDate作为日期)为布尔值
Const olappoimment=26'此日历aa
位于何处?在邮箱
或日历
下,@PatricK 9是olFolderCalendar。可能有一个带有枚举的msdn url,但我有一个我知道的olFolderCalendar=9
,只是想确保您的aa
日历在默认日历下。因为您可以将日历文件夹放在邮箱的正下方。如果将行添加到定义olappoint
,代码将正常工作。