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 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
| '==================================================================
'Script : Analyse Activite CIS.vbs
'
'Date : 3 Juillet 2009
'
'Auteur : Philippe MAITRE
'
'Objet : Extraction des RV activités CIS vers fichier Excel
'
'Site : Philips
'==================================================================
'Option Explicit
'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 |
Partager