1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
| 'Déclaration des constantes
'==========================
Const olMailItem = 0 : Const olTaskItem = 3
Const olFolderTasks = 13 : Const olFolderCalender = 9
Const employeeName = "PM"
'Définition des variables
'========================
Dim objOutlook
Dim objNameSpace
Dim objFolder
Dim MyItems
Dim CurrentAppointment
Dim strOutput
Dim wshShell
Dim objXL
Dim DateDebut
Dim DateFin
Dim AppDir :AppDir=mid(WScript.ScriptFullName,1,instrrev(WScript.ScriptFullName,"\")-1)
Dim l,c,i,rv
Dim curDateDebut,curDateFin,curSite,curDuration,curObject,curCat
'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
'Saisie des dates de début de recherche et date de fin
Do While Not IsDate(DateDebut)
DateDebut=InputBox("Date début ?","Date début",cdate("01/" & CStr(Month(Date)-1) & "/" & Year(Date)))
Loop
Do While Not IsDate(DateFin)
DateFin=InputBox("Date fin ?","Date fin",cdate("01/" & CStr(Month(Date)+1) & "/" & Year(Date)))
Loop
'Conversion en format Date
DateDebut=DateAdd("d",0,DateDebut)
DateFin=DateAdd("d",0,Datefin)
'CREATION D'UN OBJET MS EXCEL
'============================
Set objXL = CreateObject("Excel.Application")
objXL.Caption = "Microsoft Excel"
objXL.Visible = True
objXL.Workbooks.Open(appdir &"\" & "Template Activité CIS.xls")
objXL.ActiveWorkbook.SaveAs(AppDir & "\" & "Activité CIS du " & Replace(DateDebut,"/","") & " au " & Replace(DateFin,"/","") & "_" & Replace(CStr(Time),":","")& ".xls")
Set WshShell = WScript.CreateObject("WScript.Shell" )
wshShell.appActivate "Microsoft Excel"
objXL.Cells(2,1).Value = "Analyse Activité CIS du " & DateDebut & " au " & DateFin
l=5:c=1
For Each CurrentAppointment in MyItems
If CurrentAppointment.Start >= DateDebut And CurrentAppointment.Start < DateFin Then
'If IsNumeric(Left(CurrentAppointment.Location,10)) Then
If CurrentAppointment.Location <> "" Then
curSite = CurrentAppointment.Location
curDateDebut = CurrentAppointment.Start
curDateFin = CurrentAppointment.End
curDuration = CurrentAppointment.Duration
curObject = CurrentAppointment.Subject
curCat = CurrentAppointment.Categories
objXL.Cells(l, c).Value = curSite
objXL.Cells(l, c+1).Value = curDateDebut
objXL.Cells(l, c+2).Value = curDateFin
objXL.Cells(l, c+3).Value = curDuration/60
objXL.Cells(l, c+4).Value = curObject
objXL.Cells(l, c+5).Value = curCat
objXL.Cells(l, c+6).Value = Month(CDate(curDateDebut))
objXL.Cells(l, c+7).Value = Year(CDate(curDatedebut))
objXL.Cells(l, c+8).Value = employeeName
l=l+1
End If
End If
Next |
