Outlook Apptment搜索和主题,日期/时间,描述提取

时间:2014-04-14 18:59:34

标签: outlook-vba outlook-2010

所以下面的代码是一个开始。我正在尝试修改下面的代码,以便在单个工作站的当前会话中在特定日期(或今天选择此程序)之后或之后找到约会。然后,我想从约会和描述中提取主题行,并将其显示在消息框中(以便将来进行错误检查)。如果可能的话,我想在这个相同的片段中添加计算一天中约会数量的能力。

我无法正确设置对象,也无法找到将“i”绑定到Outlooks数组中正确项目的方法。我说“Outlooks数组”,因为在基本代码中我有oItems.Item(i)其中i是来自我的日历中指定号码的某个约会的项目。

使用除Item之外的其他东西可能会更好吗? 或者更好的是在数组中找到与我限制搜索的日期相关的项目位置?

以下是Dmitry链接之前的旧代码

Private Sub FindAppt()

Dim oItems As Items
Dim oItemOriginal As AppointmentItem
Dim Subject As String
Dim Descript As String

Set oItems = Outlook.Application.Session.GetDefaultFolder(olFolderCalendar).Items

   If oItems >= Format(Date, "mmmm dd yyyy") Then

       Set oItemOriginal = oItems.Item(i)

   End If

   With oItemOriginal

      Subject = .Subject
      Descript = .FormDescription

   End With

   MsgBox (Subject & Description)

End Sub

找到所需方法和代码后的新代码和新方向。我还应该使用新的方法将这些数组绑定和数组提取部分分解为单独的“Subs”?

 Sub FindAppt()

 Dim myNameSpace As Outlook.NameSpace
 Dim tdystart As Date
 Dim tdyend As Date
 Dim myAppointments As Outlook.Items
 Dim currentAppointment As Outlook.AppointmentItem
 Dim SubjectArray(50) As Variant
 Dim i As Integer
 Dim DescArray(50) As Variant
 Dim Excl As Excel.Application

Set myNameSpace = Application.GetNamespace("MAPI")
    'This line is Bonus, if you're just looking to start your search for today's_  
    date.
    tdystart = VBA.Format(Now, "Short Date") 
    'This input works which means a user form with combo boxes will work or user input_
     will work as long as user input conforms to VBA date formats.
    'tdystart = "04/01/2014" 
    'This line is Bonus, if you're just looking for the day after and after_      
     appointments.
    tdyend = VBA.Format(Now + 1, "Short Date") 
    'tdyend = VBA.Format(tdystart + 5, "Short Date")
    Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items
    myAppointments.Sort "[Start]"
    myAppointments.IncludeRecurrences = True

Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")

While TypeName(currentAppointment) <> "Nothing"

    MsgBox currentAppointment.Subject & " " & currentAppointment.FormDescription

    While currentAppointment = True

        For i = 0 To 50

        SubjectArray(i) = currentAppointment.Subject
        DescArray(i) = currentAppointment.FormDescription
        ReDim Preserve SubjectArray(1 To Count + 1)
        ReDim Preserve DescArray(1 To Count + 1)

        Next i

    Wend

    Set currentAppointment = myAppointments.FindNext

Wend

End Sub

Private Sub Timecard()

    Set Excl = Excel.Application
    Dim i As Integer
    Dim SubjectArray(byRef 50, byValue) As Variant
    Dim DecArray (byRef,byvalue)

    With Excl

        .fPath = ("C:\FilePathName\Book1.xlsx")

        Excl.Open

    End With

    For i = 0 To 50

        Excl.Application.Activesheet.Range(i, 0) = SubjectArray(i)
        Excl.Application.Activesheet.Range(i, 1) = DecArray(i)

    Next

End Property

End Sub

1 个答案:

答案 0 :(得分:0)

我不确定该行&#34; If oItems >= Format(Date, "mmmm dd yyyy") Then&#34;应该这样做:您正在将Items对象与字符串进行比较。

有关如何检索特定时间范围内的项目的示例,请参阅http://msdn.microsoft.com/en-us/library/office/ff866969(v=office.15).aspx