vba - Get list of Tracking from meeting in Outlook when the reminder pops up

Question

I have a VBA written in Outlook to get list of Tracking of the meeting in Outlook (Attendees list & their answers). I want to get an excel file saved on desktop everytime for every meeting when the reminder in Outlook pops up.

Somehow my code doesnt generate any file at all and I am not expert with Outlook VBA at all, so it's rather hard to decipher it.

  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, 4) = "Response"

    If Item.Class = olAppointment 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("D" & nLastRow) = "Accept"
                     Case olResponseDeclined
                          objExcelWorksheet.Range("D" & nLastRow) = "Decline"
                     Case olResponseNotResponded
                          objExcelWorksheet.Range("D" & nLastRow) = "Not Respond"
                     Case olResponseTentative
                          objExcelWorksheet.Range("D" & nLastRow) = "Tentative"
              End Select
           Next
        End If
    End If
 
    'Fit the columns from A to D
    objExcelWorksheet.Columns("A:D").AutoFit
 
    'Save the Excel file
   Function SaveDateTime() As String

    Dim SaveTime As Integer
    SaveTime = Round(Timer / 3600, 0)

    Dim AMPM As String: AMPM = "AM"
    If SaveTime >= 12 Then
        AMPM = "PM"
        If SaveTime > 12 Then
            SaveTime = SaveTime - 12
        End If
    End If

    SaveDateTime = "C:\Users\user1\Documents\Desktop\OutlookReport_" & _
                    Format(Date, "ddmmmyyyy") & "_" & _
                    SaveTime & AMPM & ".xlsm"

End Function
 
    
End Sub

标签： vbalistoutlooktracking