Zapco | après quelques recherche, j'arrive à récupérer les évènements futur avec le script ci-dessous, mais je n'arrive toujours pas à en creer.
Code :
- Dim objOutlook
- Dim objNameSpace
- Dim objFolder
- Dim MyItems
- Dim CurrentAppointment
- Dim strOutput
- Const olMailItem = 0
- Const olTaskItem = 3
- Const olFolderTasks = 13
- Const olFolderCalender = 9
- 'Create Outlook, Namespace, Folder Objects and Task Item
- Set objOutlook = CreateObject("Outlook.application" )
- Set objNameSpace = objOutlook.GetNameSpace("MAPI" )
- Set objFolder = objNameSpace.GetDefaultFolder(olFolderCalender)
- Set MyItems = objFolder.Items
- dtLastWeek = DateAdd("d", -7, date)
- dtNextWeek = DateAdd("d", +7, date)
- strOutput = strOutput & "<h2>Meetings This Week</h2>"
- icount = 0
- For Each CurrentAppointment in MyItems
- If CurrentAppointment.Start >= dtLastWeek And CurrentAppointment.Start <= Date Then
- icount = icount + 1
- strOutput = strOutput & icount & ". " & CurrentAppointment.Subject & vbTab & " <b>Time:</b> " & CurrentAppointment.Start & " <b>duration</b> " & CurrentAppointment.Duration& vbCRLF
- txtNames = txtNames & CurrentAppointment.Subject & vbTab & " <b>Time:</b> " & CurrentAppointment.Start & " <b>duration</b> " & CurrentAppointment.Duration& vbCRLF
- if len(CurrentAppointment.Body) > 0 then
- strOutput = strOutput & "<blockquote><b>Notes: </b>" & CurrentAppointment.body & "</blockquote>" & vbCrLF & vbCrLF
- else
- strOutput = strOutput & vbCrLf
- end if
- End If
- Next
- strOutput = strOutput & "<h2>Due Next Week</h2>"
- icount = 0
- For Each CurrentAppointment in MyItems
- If CurrentAppointment.Start > date And CurrentAppointment.Start <= dtNextWeek Then
- icount = icount + 1
- strOutput = strOutput & icount & ". " & CurrentAppointment.Subject & vbTab & " <b>Time:</b> " & CurrentAppointment.Start & " <b>Duration</b> " & CurrentAppointment.Duration & vbCRLF
- if len(CurrentAppointment.Body) > 0 then
- strOutput = strOutput & "<blockquote><b>Notes: </b>" & CurrentAppointment.body & "</blockquote>" & vbCrLF & vbCrLF
- else
- strOutput = strOutput & vbCrLf
- end if
- End If
- Next
- strOutput = strOutput & "<h2>Future Tasks</h2>"
- icount = 0
- For Each CurrentAppointment in MyItems
- If CurrentAppointment.Start >= dtNextWeek Then
- icount = icount + 1
- strOutput = strOutput & icount & ". " & CurrentAppointment.Subject
- strOutput = strOutput & " Due -<b> " & CurrentAppointment.Start & "</b>" & vbCrLf
- if len(CurrentAppointment.Body) > 0 then
- strOutput = strOutput & "<blockquote><b>Notes: </b>" & CurrentAppointment.body & "</blockquote>" & vbCrLF & vbCrLF
- else
- strOutput = strOutput & vbCrLf
- end if
- End If
- Next
- msgbox txtNames
-
- Set objMsg = objOutlook.CreateItem(olMailItem)
- objMsg.To = "manager@domain.com" ' your reminder notification address
- objMsg.Subject = "Status Report - " & Date()
- objMsg.Display
- strOutput = replace(strOutput,vbCrLF,"<br>" )
- objMsg.HTMLBody = strOutput
- 'Display results to user, if any.
- ' If strOutput > "" Then
- ' Msgbox strOutput, vbExclamation, "Tasks For Today"
- ' Else
- ' Msgbox "No Tasks Today", vbInformation,"Tasks For Today"
- ' End If
- 'Clean up
- Set objFolder = Nothing
- Set objNameSpace = Nothing
- set objOutlook = Nothing
- set objMsg = Nothing
|
|