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

gotovamsee

New Member
Joined
Jun 22, 2009
Messages
14
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.

Nice to have: Count of Accepted, Declined, Not Responded including the 'Required Attendees' as accepted.



VBA 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
 
Last edited:

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top