[英]How to get outlook appointments via Excel VBA without listingrecurring appointments
[英]Search Appointments in excel with VBA
我正在嘗試編寫一個腳本,以讀取我的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
但無論如何都不要走:\\
抱歉我的英語不好。
問題是您沒有定義什么是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
您的代碼可以正常工作,並使用默認Calendar
下名為aa
的Calendar
進行測試。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.