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.
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: