I modified this online code and have come thus far which works for me by extracting attendees from a given category and saving it on sharepoint excel. However it does not entirely do what I need.
Question: How to run this macro on one specific calendar event that is known to start at a given time (09:00) for 1Hr and with a known string in the subject "weekly meeting"?.
Nice to have: How to count Accepted, Declined, Not Responded including the 'Required Attendees' as accepted.
Code
- 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
- Next
- End If
- End If
- 'Fit the columns from A to D
- objExcelWorksheet.Columns("A:C").AutoFit
- 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