Event extraction using VBA – How to pick a desired event that is scheduled to start at a known time with a known subject

I modified this online code which works for me today by extracting attendees from a given category and saving it on sharepoint excel. However it does not entirely fulfill my requirements.

Please help me in getting this to also work as below…

Requirement: Trigger not by event notifications but on a specified date and time. Provided it finds my desired event from a known string ‘Weekly meeting’ in the subject. And this event is not recurring but scheduled every week as new. The idea is to extract attendees a day before the meeting starts.

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

    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"

    'If InStr(Item.Subject, "Weekly Meeting") Then

    If Item.Categories = "HRIT Breakfast" Then

       Set objMeeting = Item

       Set objAttendees = objMeeting.Recipients

       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


        End If

    End If

    'Fit the columns from A to D


    objExcelWorksheet.ListObjects.Add(xlSrcRange, objExcelWorksheet.Range("A$1:$C$40"), , xlYes).Name = "Attendees"

    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 = "Somelink.xlsx"

    objExcelWorkbook.Close True, strExcelFile

    '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

Leave a Reply

Your email address will not be published. Required fields are marked *