Question

我找到了一些可行的代码来查找和打印以提供给定日期范围内的所有约会开始日期和主题。这很有效。

我所追求的是输出以下内容的方法：开始日期/时间;学科; “预约身体的行文字”，第X行

但仅限于数据范围内的约会，在约会的正文中也有一定的字符串。

这是我正在使用的代码的一部分...... Dim oAppt作为Outlook.AppointmentItem MyFile.WriteLine（oAppt.Start＆amp;“;”＆amp; oAppt.Subject）

我没有在oAppt.Body上找到任何方法或功能来进行搜索。下面是我现在的VBA脚本的完整代码：

Sub FindAppts()
    Dim daStart, daEnd As Date
    Dim oCalendar As Outlook.Folder
    Dim oItems As Outlook.Items
    Dim oItemsInDateRange As Outlook.Items
    Dim oFinalItems As Outlook.Items
    Dim oAppt As Outlook.AppointmentItem
    Dim strRestriction As String
    ' Declare a FileSystemObject, and prepare it to take the data.
    Dim fso, MyFile
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set MyFile = fso.CreateTextFile("c:\test\CalendarLogOutput.log", True)

    daStart = Format(Date, "mm/dd/yyyy hh:mm AMPM")
    daEnd = DateAdd("d", 30, daStart)
    daEnd = Format(daEnd, "mm/dd/yyyy hh:mm AMPM")
    Debug.Print "Start:", daStart
    Debug.Print "End:", daEnd

    ' Construct a filter for the next 30-day date range.
    strRestriction = "[Start] >= '" & daStart _
    & "' AND [End] <= '" & daEnd & "'"
    Debug.Print strRestriction

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

    ' To include recurring appointments, sort by using the Start property.
    oItems.IncludeRecurrences = True
    oItems.Sort "[Start]"

    ' Restrict the Items collection for the 30-day date range.
    Set oItemsInDateRange = oItems.Restrict(strRestriction)

    ' Construct a filter for subjects that contain ”team”.
    Const PropTag  As String = "http://schemas.microsoft.com/mapi/proptag/"
    strRestriction = "@SQL=" & Chr(34) & PropTag _
        & "0x0037001E" & Chr(34) & " like '%team%'"

    ' Restrict the last set of filtered items for the subject.
    Set oFinalItems = oItemsInDateRange.Restrict(strRestriction)

    ' Sort and print the final results.
    oFinalItems.Sort "[Start]"
    For Each oAppt In oFinalItems

        'Here I need to find out how large the body is...
        If oAppt.Body.Find("BCFLUP") Is Not Nothing Then
            MyFile.WriteLine (oAppt.Start & "; " & oAppt.Subject & "; " & "Requires FLUP")
        End If

        'This line outputs simple data.
        'Debug.Print oAppt.Start, oAppt.Subject
        'MyFile.WriteLine (oAppt.Start & ";" & oAppt.Subject)
    Next

    ' Close the file.
    MyFile.Close

End Sub

Answer 1

使用vbCr将oAppt.Body拆分为一个数组，其中每一行都是一个元素。

InStr找到字符串。元素位置给出了线条。如果从零开始，则元素位置为+。

Outlook日历VBA代码，用于查找包含特定字符串的所有约会

1 个答案: