Извлечение участников в Excel из события Office365 с соответствующей темой и временем начала

Question

Как изменить этот рабочий код для переключения с триггера уведомления об элементе на триггер, указанный c? В основном от Private Sub (Item as Object) к Sub ()

Будучи новичком и происходящим из powerapps, я не могу заставить его работать после преобразования в publi c sub (). Невозможно инициировать условие if таким образом.

Этот код выполняется всякий раз, когда вызывается напоминание. Вместо этого я хочу найти событие в соответствии с моим условием «если», совпадающим со строкой темы: «Приглашение бота» и Расписание с <09:00 до 10:00>.

Private Sub Application_Reminder(ByVal Item As Object)
    Dim objMeeting As Outlook.AppointmentItem
    Dim objAttendees As Outlook.Recipients
    Dim objAttendee As Outlook.Recipient
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkbook As Excel.Workbook
    Dim objExcelWorksheet As Excel.Worksheet
    Dim strExcelFile As String
    Dim nLastRow As Integer
    Dim strTempFolder As String
    Dim objShell, objFileSystem As Object
    Dim objTempFolder, objTempFolderItem As Object

    If InStr(LCase(Item.subject), "bot invitation") > 0 And TimeValue(Item.Start) = TimeValue("09:00:00 AM") Then

         Set objMeeting = Item
         Set objAttendees = objMeeting.Recipients

    'On Error Resume Next
    'Create a new Excel file
                Set objExcelApp = CreateObject("Excel.Application")
                Set objExcelWorkbook = objExcelApp.Workbooks.Add
                Set objExcelWorksheet = objExcelWorkbook.Sheets("Sheet1")
                objExcelWorksheet.Cells(1, 1) = "Name"
                objExcelWorksheet.Cells(1, 2) = "Type"
                'objExcelWorksheet.Cells(1, 3) = "Email Address"
                objExcelWorksheet.Cells(1, 3) = "Response"
                'Item.subject = Nothing
                'Item.Start = Nothing


       If objAttendees.Count > 0 Then
          For Each objAttendee In objAttendees
              nLastRow = objExcelWorksheet.Range("A" & objExcelWorksheet.Rows.Count).End(xlUp).Row + 1
              'Input the attendee names
              objExcelWorksheet.Range("A" & nLastRow) = objAttendee.Name

              'Input the type of attendees
              Select Case objAttendee.Type
                     Case "1"
                          objExcelWorksheet.Range("B" & nLastRow) = "Required Attendee"
                     Case "2"
                          objExcelWorksheet.Range("B" & nLastRow) = "Optional Attendee"
              End Select

              'Input the email addresses of attendees
              'objExcelWorksheet.Range("C" & nLastRow) = objAttendee.Address

              'Input the responses of attendees
              Select Case objAttendee.MeetingResponseStatus
                     Case olResponseAccepted
                          objExcelWorksheet.Range("C" & nLastRow) = "Accept"
                     Case olResponseDeclined
                          objExcelWorksheet.Range("C" & nLastRow) = "Decline"
                     Case olResponseNotResponded
                          objExcelWorksheet.Range("C" & nLastRow) = "Not Respond"
                     Case olResponseTentative
                          objExcelWorksheet.Range("C" & nLastRow) = "Tentative"
              End Select
           Next
        End If

    'Fit the columns from A to D
    objExcelWorksheet.Columns("A:C").AutoFit
    'Set rng = Selection.SpecialCells(xlCellTypeVisible)
    'You can also use a range if you want
    'Set rng = objExcelWorksheet.Range("A1:C50").SpecialCells(xlCellTypeVisible)
    objExcelWorksheet.ListObjects.Add(xlSrcRange, objExcelWorksheet.Range("A$1:$C$40"), , xlYes).Name = "Attendees"
    'Ws.ListObjects.Add(xlSrcRange, Ws.Range("A$1:$BE$1500"), , xlYes).Name = "New_Table_Name"
    objExcelWorksheet.ListObjects("Attendees").TableStyle = "TableStyleLight1"


    'Save the Excel file in a temp folder
    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    'strTempFolder = objFileSystem.GetSpecialFolder(2).Path & "\temp " & Format(Now, "yyyy-mm-dd hh-mm-ss")
    'MkDir (strTempFolder)
    strExcelFile = "mylink" & "\Attendee List for " & Item.subject & " (" & Format(Now, "yyyy-mm-dd") & ").xlsx"
    objExcelWorkbook.Close True, strExcelFile

 End If

    'Print the Excel file
    'Set objShell = CreateObject("Shell.Application")
    'Set objTempFolder = objShell.NameSpace(0)
    'Set objTempFolderItem = objTempFolder.ParseName(strExcelFile)
    'objTempFolderItem.InvokeVerbEx ("print")

    'Delete the temp folder and temp Excel file
    'objFileSystem.DeleteFolder (strTempFolder)
End Sub

Answer 1

Чтобы найти предмет, а не ждать срабатывания напоминания:

Option Explicit

Private Sub restrictSubject_ifDateTime()

Dim calFolder As Folder
Dim calItems As Items

Dim strFilter As String
Dim srchSubject As String

Dim calItms As Items
Dim resItms As Items

' follows original code, applicable item declared as an appointment
Dim calMtg As AppointmentItem

Dim i As Long
Dim resItmsCount As Long

Dim fromDate As Date

srchSubject = "bot invitation"
strFilter = "[Subject] = '" & srchSubject & "'"
Debug.Print strFilter

Set calFolder = Session.GetDefaultFolder(olFolderCalendar)
Set calItms = calFolder.Items

Set resItms = calItms.Restrict(strFilter)
resItmsCount = resItms.Count
Debug.Print resItmsCount

If resItmsCount > 0 Then

    For i = 1 To resItmsCount

        If resItms(i).Class = olAppointment Then

            Set calMtg = resItms(i)

            Debug.Print calMtg.Subject

            ' There is likely a way to apply a restrict by date/time,
            '  but may not be necessary.
            fromDate = Date    ' perhaps Date + 1 depending on when code runs

            Debug.Print fromDate
            Debug.Print calMtg.Start

            If calMtg.Start > fromDate Then

                If InStr(calMtg.Start, "9:00:00 AM") Then

                    calMtg.Display

                    ' you may add revised Application_Reminder code, dropping redundant lines

                    ' or reuse as is, with marginal loss of efficiency
                    Application_Reminder calMtg

                End If
            End If

        End If
    Next
End If

End Sub