[Connexion à Exchange][Récupération des agendas][Util. Objet CDO.Iappointment]

**Théolude** · 22/07/2008, 12h11

Bonjour,

Toujours dans l'objectif d'extraire les agendas d'exchange

et d'en exporter le contenu dans un applicatif extérieur je suis en train de développer un script en VBS qui sera censé scanner les comptes de tous les utilisateurs, se connecter à leur agenda et exporter au format texte les rendez-vous des 15 prochains jours.

Je suis néophyte en VBS, à force de documentation j'ai pondu ça

:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim objCdoPerson
Dim objCdoAppointment
Dim iMailBox
Dim iAppointment
Dim strCalendarUrl
 
strURL = "mailto:xxxxxxxxxxx@xxxxxxxxxx.xxx"
Set objCdoPerson = CreateObject("CDO.Person")
Set iMailBox = objCdoPerson.GetInterface("IMailbox")
Set objCdoAppointment = CreateObject("CDO.Appointment")
 
objCdoPerson.DataSource.Open strURL
 
WScript.Echo "URL du calendrier " & iMailBox.Calendar
 
Set strCalendarUrl = iMailBox.Calendar
Set iAppointment = objCdoAppointment.GetInterface("IMailbox")
 
iAppointment.DataSource.Open strCalendarUrl

C'est un premier test, qui consiste à me connecter un compte déterminé et à tenter de me connecter à son agenda. Je récupère bien iMailBox.Calendar dans WScript.Echo.

Par contre il me fait une erreur sur Set strCalendarUrl = iMailBox.Calendar ... Objet Requis: '[string: "file://./backoffices/"]', code d'erreur 800A01A8 ... Je ne comprends pas cette erreur alors qu'il m'affiche très correctement la valeur complète de strCalendarUrl juste avant !!

Merci de votre aide.

Théo

**Théolude** · 22/07/2008, 12h18

... J'ai été un peu vite à poster avant de tenter un peu plus.

Voici la nouvelle version de mon script:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim objCdoPerson
Dim objCdoAppointment
Dim iMailBox
Dim iAppointment
Dim strCalendarUrl
 
strURL = "mailto:administrateur@terre-et-decor.com"
Set objCdoPerson = CreateObject("CDO.Person")
Set iMailBox = objCdoPerson.GetInterface("IMailbox")
Set objCdoAppointment = CreateObject("CDO.Appointment")
 
objCdoPerson.DataSource.Open strURL
 
WScript.Echo "URL du calendrier " & iMailBox.Calendar
 
Set iAppointment = objCdoAppointment.GetInterface("IAppointment")
iAppointment.DataSource.Open iMailBox.Calendar

Il me fait toujours une erreur

, dernière ligne (donc toujours avec l'url du calendrier), ID de colonne non valide, 80040E1, Source CDO.Appointment.1 ... Pour moi c'est du chinois, qu'est ce qui ne va pas dans mon code?

Merci de votre aide.

**ced600** · 22/07/2008, 12h39

Que te renvois normalement calendar ? un chemin vers un calendrier ?

Si c le cas, peux tu essayer dans ta dernière ligne de remplacer iMailBox.calendar par une string représentant le chemin complet vers un calendrier ? Puis par le chemin que te renvois iMailBox.calendar (en dur en string) ?
Cela permettra de déterminer à quel niveau cela merde : chemin du calendrier faux, iAppointment.DataSource.Open mal utilisé, ...

**Théolude** · 22/07/2008, 13h46

Envoyé par ced600

Que te renvois normalement calendar ? un chemin vers un calendrier ?

Oui

Envoyé par ced600

Si c le cas, peux tu essayer dans ta dernière ligne de remplacer iMailBox.calendar par une string représentant le chemin complet vers un calendrier ? Puis par le chemin que te renvois iMailBox.calendar (en dur en string) ?
Cela permettra de déterminer à quel niveau cela merde : chemin du calendrier faux, iAppointment.DataSource.Open mal utilisé, ...

OK. La chaîne récupérée est du type:
file://./backofficestorage/xxxxxxxxxxxxx.com/MBX/yyyyyyyyyyyy/Calendrier
Où xxxxxx est le nom de domaine du serveur, et yyyyy un identifiant utilisateur.

Quand je test avec cette chaîne directement, ça me renvoie la même erreur. Ce serait donc:
1. Ou l'appel de la méthode que je fais n'importe comment, et je dois lui donner un autre argument (??? help !!

)
2. Ou mon appel à objCdoPerson qui pour une raison obscure me renvoit n'importe quoi...

Pour infos le path file://./backofficestorage/xxxxxxxxxxxxx.com/MBX/yyyyyyyyyyyy/Calendrier ne correspond à rien sur le serveur...

Théo

**Théolude** · 22/07/2008, 13h55

J'ai été voir là:
http://msdn.microsoft.com/en-us/libr...EXCHG.65).aspx
et aussi là:
http://msdn.microsoft.com/en-us/libr...EXCHG.65).aspx

Apparemment ils utilisent un objet ADODB pour trouver l'url de connexion... Je ne connais pas ADODB, quelques tuyaux?

Je vais essayer de faire quelque chose à partir du script cité au dessus... histoire de. Mais ils spécifient quand même:

Note The URLs in the preceding table are only examples. You should not construct them manually in your application. You can retrieve all of the URLs in a user's localized mailbox folder by using the IMailBox Interface on a Collaboration Data Objects (CDO) Person object or by retrieving properties, such as the inbox Field or calendar Field, on the base mailbox folder.

Je suis perplexe...

Théo

**ced600** · 22/07/2008, 14h30

Perso je n'ai jamais piloté exchange, mais j'ai trouvé des meilleurs lien sur le site MSDN :

L'utilisation de la méthode Open de l'interface IDataSource.
L'interface ImailBox.
Modifying Objects Using CDOEX and ADO.

Dans le premier lien regarde notement le dernier exemple (du VBS).

**Théolude** · 22/07/2008, 17h20

Bonsoir,

J'ai lu la documentation que tu cites. Je m'en suis inspiré pour repondre un petit truc dans ce goût là

:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Dim objCdoPerson
Dim objCdoAppointment
Dim iMailBox
Dim iAppointment
Dim strCalendarUrl
Dim objAdodbConnexion
 
strURL = "mailto:xxxxxxx@xxxxxxxxxx.com"
 
'' Connexion au compte de l'utilisateur via son email
'' Récupération de la racine du calendrier de l'utilisateur
Set objCdoPerson = CreateObject("CDO.Person")
Set iMailBox = objCdoPerson.GetInterface("IMailbox")
objCdoPerson.DataSource.Open strURL
 
'' Connexion au calendrier de l'utilisateur
Set objAdodbConnexion = CreateObject("ADODB.Connection")
objAdodbConnexion.Provider = "ExOLEDB.DataSource"
objAdodbConnexion.Open iMailBox.Calendar
 
'' Création d'un objet appointment pour le calendrier
Set objCdoAppointment = CreateObject("CDO.Appointment")
Set iAppointment = objCdoAppointment.GetInterface("IAppointment")
 
'' Lecture des appointements
iAppointment.DataSource.Open iMailBox.Calendar, objAdodbConnexion, adModeReadWrite
 
'' Fermeture de la connexion
objAdodbConnexion.Close
Set objAdodbConnexion = Nothing

Même erreur sur la ligne 26, ID de colonne non valide...

Il y a quelque chose que j'ai mal compris / fait?
J'ai commenté mon code pour qu'il soit plus causant... et vous aide éventuellement à trouver le truc qui tourne pas rond...

Théo

NB: C'est peut être très puissant VBS mais pour moi ça confine au chinois les appels à ces objets exotiques

**Théolude** · 22/07/2008, 17h33

Bon, je suis aussi tombé sur ça, c'est du VB, et c'est pour créer un appointment, mais la logique de connexion est la même... J'arrête pour ce soir, mais demain je tente de m'en inspirer pour pondre un truc qui marche

http://msdn.microsoft.com/en-us/library/ms988669.aspx

Théo

**Théolude** · 29/07/2008, 11h02

Je suis TRES malheureux

, d'avoir perdu les multiples messages échangés lors de cette discussion et qui détaillaient les différentes démarches entreprises, qui faisaient mention d'url intéressantes, etc...

En tout cas MERCI

aux administrateurs du site de l'avoir remis en état de fonctionnement

Pour finir voici la version finale et fonctionelle du script

:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
' [Theo - 23/07/2008]
' Inspiré très largement d'un script trouvé ici http://www.outlookexchange.com/articles/glenscales/pubmetwb.asp
 
' On ne veut pas être interrompu par les erreurs, du style un compte utilisateur inaccessible
' On logue les erreurs plus loin
On Error Resume Next
 
'' --------------------------------------------------------------------------------
'' Définition des fonctions
'' --------------------------------------------------------------------------------
Function convertUTC(strDateToConvert, strTimeZoneFrom, strTimeZoneTo)
	Set objCdoAppointment = CreateObject("CDO.Appointment")
	Set objCdoConfiguration = CreateObject("CDO.Configuration")
 
	objCdoAppointment.Configuration = objCdoConfiguration
	objCdoConfiguration.Fields("urn:schemas:calendar:timezoneid").Value = strTimeZoneFrom
	objCdoConfiguration.Fields.Update
 
	objCdoAppointment.StartTime = strDateToConvert
	objCdoConfiguration.Fields("urn:schemas:calendar:timezoneid").Value = strTimeZoneTo
	objCdoConfiguration.Fields.Update
 
	convertUTC = objCdoAppointment.StartTime
End Function
 
'' --------------------------------------------------------------------------------
'' Création des dates au format ISO pour la requête sur Exchange
'' --------------------------------------------------------------------------------
 
' Calcul de la date de départ et de la date de fin
strDateStart = DateAdd("d", +0, Date)
strDateEnd = DateAdd("d", +28, Date) ' Ajout de 28 jours (4 semaines de visibilité)
 
' Création des deux dates au format UTC avec l'interval
intDateStart = convertUTC(strDateStart, 0, 0)
intDateEnd = convertUTC(strDateEnd & " " & TimeValue("23:59:59"), 0, 0)
 
' Récupération de l'année
strYearStart = Year(intDateStart)
strYearEnd = Year(intDateEnd)
 
' Formatage des mois sur deux chiffres
strMonthStart = Month(intDateStart)
strMonthEnd = Month(intDateEnd)
If strMonthStart < 10 Then
	strMonthStart = 0 & strMonthStart
End If
 
If strMonthEnd < 10 Then
	strMonthEnd = 0 & strMonthEnd
End If
 
' Formatage des jours sur deux chiffres
strDayStart = Day(intDateStart)
strDayEnd = Day(intDateEnd)
If strDayStart < 10 Then
	strDayStart = 0 & strDayStart
End If
If strDayEnd < 10 Then
	strDayEnd = 0 & strDayEnd
End If
 
' Formatage de la chaîne finale
strFormatDateStart = strYearStart & "-" & strMonthStart & "-" & strDayStart & "T" & formatdatetime(intDateStart, 4) & ":" & "00Z"
strFormatDateEnd = strYearEnd & "-" & strMonthEnd & "-" & strDayEnd & "T" & formatdatetime(intDateEnd, 4) & ":" & "00Z"
'' --------------------------------------------------------------------------------
 
'' --------------------------------------------------------------------------------
'' Récupération de la liste des utilisateurs du domaine
'' --------------------------------------------------------------------------------
 
' Connexion LDAP au conteneur des utilisateurs du domaine
Set objConnexionForLdap = CreateObject("ADODB.Connection")
Set objRecordSetLdap = CreateObject("ADODB.Recordset")
Set objAdodbCommand = CreateObject("ADODB.Command")
 
' Construction de la requête et exécution
objConnexionForLdap.Open "Provider=ADsDSOObject;"
objAdodbCommand.ActiveConnection = objConnexionForLdap
objAdodbCommand.CommandText = "<LDAP://OU=Societe,DC=mondomaine,DC=local>;(ObjectClass=user);cn,mail,sAMAccountName;subtree" 'NB ici on utilise local !!
 
i = 0
Dim tabUsers(200)
Dim strErreur
Set objRecordSetLdap = objAdodbCommand.Execute
 
' Parcours des enregistrements
Do Until objRecordSetLdap.EOF
 
	'' --------------------------------------------------------------------------------
	'' Requête sur la base Exchange
	'' --------------------------------------------------------------------------------
	Set objRecord = CreateObject("ADODB.Record")
	Set objConnexion = CreateObject("ADODB.Connection")
	Set objRecordSet = CreateObject("ADODB.Recordset")
	objConnexion.Provider = "ExOLEDB.DataSource"
 
 
	' Récupération de la racine du calendrier de l'utilisateur
	' strAccount = objRecordSetLdap.Fields("sAMAccountName")
	strAccount = Left(objRecordSetLdap.Fields("mail"), InStr(objRecordSetLdap.Fields("mail"), "@") - 1)
	strCalendarUrl = "file://./backofficestorage/mondomaine.com/MBX/" & strAccount & "/Calendrier/" ' Et ici .com !!
 
	' Différentes tentatives avec des urls des connexions différentes
	objRecord.Open strCalendarUrl
	If Err > 0 Then
 
		objRecord.Close
		strCalendarUrl = "file://./backofficestorage/mondomaine.com/MBX/" & objRecordSetLdap.Fields("sAMAccountName") & "/Calendrier/" ' Et ici .com !!
 
		objRecord.Open strCalendarUrl 
 
		If Err > 0 Then
			objRecord.Close
			strCalendarUrl = "file://./backofficestorage/mondomaine.com/MBX/" & objRecordSetLdap.Fields("cn") & "/Calendrier/" ' Et ici .com !!
 
			objRecord.Open strCalendarUrl 
 
		End If
	End If
 
	' Détection des erreurs de connexions
	If Err = 0 Then
 
		' Récupération du nom et du prénom de la personne
		strRealUserName = objRecordSetLdap.Fields("cn")
 
		' On remplace les espaces pour créer un nom du fichier utilisable en script FTP
		strUserName = Replace(strRealUserName, " ", "_")
		tabUsers(i) = strUserName
 
		' Connexion
		objRecordSet.ActiveConnection = objRecord.ActiveConnection
 
		' Requête de récupération de l'agenda
		strQuery = "SELECT ""DAV:href"", " & _
			" ""urn:schemas:mailheader:subject"", " & _
			" ""urn:schemas:calendar:dtstart"", " & _
			" ""urn:schemas:calendar:dtend"", " & _
			" ""urn:schemas:calendar:organizer"", " & _
			" ""urn:schemas:calendar:busystatus"", " & _
			" ""urn:schemas:calendar:location"", " & _
			" ""urn:schemas:calendar:alldayevent"", " & _
			" ""DAV:contentclass"" " & _
			"FROM scope('shallow traversal of """ & strCalendarUrl & """') " & _
			"WHERE (""urn:schemas:calendar:dtstart"" >= CAST(""" & strFormatDateStart & """ as 'dateTime')) " & _
			"AND (""urn:schemas:calendar:dtend"" <= CAST(""" & strFormatDateEnd & """ as 'dateTime')) " & _
			"AND ""urn:schemas:mailheader:subject"" <> '' " & _
			"AND ""DAV:contentclass"" = 'urn:content-classes:appointment' " & _
			"ORDER BY ""urn:schemas:calendar:dtstart"" ASC"
 
		objRecordSet.Source = strQuery
 
		If Err = 0 Then
			'' --------------------------------------------------------------------------------
 
			'' --------------------------------------------------------------------------------
			'' Parcours des enregistrements et création du fichier
			'' --------------------------------------------------------------------------------
 
			' Création de l'objet pour la création du fichier d'export
			Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
 
			' Lancement de la requête et parcours des enregistrements
			objRecordSet.Open
 
			If objRecordSet.RecordCount <> 0 Then
 
				Set objOutPutFile = objFileSystemObject.CreateTextFile(strUserName & ".data", True)
				objRecordSet.MoveFirst
 
				While Not objRecordSet.EOF
 
					strSubject = objRecordSet.Fields("urn:schemas:mailheader:subject").Value
					strDateDebut = objRecordSet.Fields("urn:schemas:calendar:dtstart").Value
					strDateFin = objRecordSet.Fields("urn:schemas:calendar:dtend").Value
					strCategories = objRecordSet.Fields("urn:schemas:calendar:busystatus").Value
					strLocation = objRecordSet.Fields("urn:schemas:calendar:location").Value
					boolAllDayEvent = objRecordSet.Fields("urn:schemas:calendar:alldayevent").Value
					strOrganizer = objRecordSet.Fields("urn:schemas:calendar:organizer").Value
 
					' Construction de la ligne DATA à exporter
					strLine = strDateDebut & vbTab & _
							strDateFin & vbTab & _
							strSubject & vbTab & _
							strLocation & vbTab & _
							strCategories & vbTab & _
							boolAllDayEvent & vbTab & _
							strOrganizer
 
					objOutPutFile.WriteLine strLine
 
					objRecordSet.MoveNext
				Wend
 
				objOutPutFile.Close
				Set objOutPutFile = Nothing
			End If
			objRecordSet.Close
 
			' Fin de boucle
			Set objRecordSet = Nothing
			i = i + 1
		Else
			' Gestion des erreurs
			strErreur = strErreur & "Lecture de l'agenda de : " & strUserName & vbTab & Err.Description & vbCrLf
			Err.Clear
		End If
		'' --------------------------------------------------------------------------------
	Else
		' Gestion des erreurs
		strErreur = strErreur & "Accès au compte de : " & strAccount &  vbTab & strCalendarUrl & vbTab & Err.Description & vbCrLf
		Err.Clear
 
	End If
 
	' On part sur l'enregistement LDAP suivant
	objRecordSetLdap.MoveNext
Loop
 
'' --------------------------------------------------------------------------------
'' Export en FTP des fichiers générés
'' --------------------------------------------------------------------------------
 
' Création des objets nécessaires
Set objFtpCmdFile = objFileSystemObject.CreateTextFile("ftpagenda.cmd", True)
Set shellCmd = WScript.CreateObject("WScript.Shell")
 
' Création du fichier de commandes FTP
With objFtpCmdFile
 .WriteLine "xxxxxxx" ' User FTP
 .WriteLine "xxxxxxx" ' Mot de passe FTP
 
 For j = 0 To i
 	.WriteLine "PUT " & tabUsers(j) & ".data"
 Next
 
 .WriteLine "DISCONNECT"
 .WriteLine "QUIT"
 .Close
End With
 
' On envoie le fichier en FTP et on le supprime du poste
' On attend la fin de l'exécution (option true), et on masque la fenêtre (option 0)
shellCmd.Run "ftp -v -s:ftpagenda.cmd xxxxxxxxx", 0, true ' Remplacer par l'url du serveur FTP
 
' Suppression des fichiers cmd et data (sécurité)
objFileSystemObject.DeleteFile("*.cmd")
objFileSystemObject.DeleteFile("*.data")
'' --------------------------------------------------------------------------------
 
WScript.Echo strErreur

Quelques remarques sur les subtilités rencontrées:
La chaine de connexion LDAP est bien sur mondomaine.local, MAIS (pourquoi?) la chaine de connexion aux différents calendriers des utilisateurs du domaine est du style mondomaine.com. ATTENTION également au fait que tout les utilisateurs n'ont pas une chaine de connexion formée de la même manière, d'où les 3 if imbriqués pour tester différentes chaîne (je ne sais pas pourquoi il en est ainsi...).

Dernière chose, je logue les erreurs.... mais je n'en fais rien (pour l'instant), à vous de voir ce que vous voulez en faire...

Voilà, Théo

**Théolude** · 29/07/2008, 11h12

NB:
Pour connaitre les différentes formes de l'url de connexion au calendrier d'un utilisateur. Connectez-vous avec son identifiant sur la machine où est installé Exchange (attention seul les administrateurs peuvent normalement se logger sur cette machine, pensez à donner temporairement les droits à l'utilisateur choisi).

Lancez ce script en utilisant l'email par défaut de l'utilisateur considéré.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
email = "monutilisateur@mondomaine.monextension"
strURL = "mailto:" & email
 
Set Person = CreateObject("CDO.Person")
Set Mailbox = Person.GetInterface("IMailbox")
Person.DataSource.Open strURL
 
WScript.Echo "URL de la boite mail " & email & " = " & Mailbox.Inbox
WScript.Echo "URL de l'agenda " & email & " = " & Mailbox.Calendar

Voilà

**ced600** · 29/07/2008, 11h53

pour le script, ce sera certainement utile.

Pour les liens si tu fouilles ton historique de ton explorateur tu pourras peut êtrre les retrouver.

**Théolude** · 29/07/2008, 12h00

Envoyé par ced600

Pour les liens si tu fouilles ton historique de ton explorateur tu pourras peut êtrre les retrouver.

Euh... non merci

Je partage le principe de l'entraide et de la collaboration, mais si je dois aller rechercher dans mon historique je vais y passer des plombes...

Sinon dernier aménagement du script, dans la requête, préférez cette version pour que ce soit lisible au format texte.

Pour la requête:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
' Requête de récupération de l'agenda
		strQuery = "SELECT ""DAV:href"", " & _
			" ""urn:schemas:httpmail:subject"", " & _
			" ""urn:schemas:calendar:dtstart"", " & _
			" ""urn:schemas:calendar:dtend"", " & _
			" ""urn:schemas:calendar:organizer"", " & _
			" ""urn:schemas:calendar:busystatus"", " & _
			" ""urn:schemas:calendar:location"", " & _
			" ""urn:schemas:calendar:alldayevent"", " & _
			" ""DAV:contentclass"" " & _
			"FROM scope('shallow traversal of """ & strCalendarUrl & """') " & _
			"WHERE (""urn:schemas:calendar:dtstart"" >= CAST(""" & strFormatDateStart & """ as 'dateTime')) " & _
			"AND (""urn:schemas:calendar:dtend"" <= CAST(""" & strFormatDateEnd & """ as 'dateTime')) " & _
			"AND ""urn:schemas:mailheader:subject"" <> '' " & _
			"AND ""DAV:contentclass"" = 'urn:content-classes:appointment' " & _
			"ORDER BY ""urn:schemas:calendar:dtstart"" ASC"

Pour la création du fichier d'export:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

strSubject = objRecordSet.Fields("urn:schemas:httpmail:subject").Value

Article de référence: http://msdn.microsoft.com/en-us/libr...EXCHG.10).aspx et http://msdn.microsoft.com/en-us/libr...EXCHG.10).aspx

Théo

**AlainTech** · 03/08/2008, 21h21

Envoyé par ced600 le 23/07/2008 à 10h18

J'ai remarqué dans les exemples que MS faisait cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Set Info   = CreateObject("ADSystemInfo")
    Set InfoNT = CreateObject("WinNTSystemInfo")
    Set Conn   = CreateObject("ADODB.Connection")
    Set iMsg   = CreateObject("CDO.Message")
    Set iPer   = CreateObject("CDO.Person")
 
    iPer.DataSource.Open "LDAP://" & Info.UserName
    Set iMbx = iPer.GetInterface("IMailbox")

Toi tu fais différement, as tu essayé ainsi pour avoir ton ImailBox (on ne sait jamais).

Bien que tu utilises le langage VBS, tu fais plus du Windows qu'autres choses

En fait tous ces objets sont présent nativement sur le SE et permette dans ton cas de piloter exchange.
En gros tu récupère un objet déjà existant et instancié, et ensuite tu te balade d'objet en objet qu'il contient, tu récupère ou positionne les valeurs des propriétés, et tu utilises les méthodes disponibles.
Là il te faut plus de la connaissance dans la bibliothèque d'objet que dans le VBS.
Perso je ne pourrais aps t'aider beaucoup, car je n'ai pas cette connaissance. En dehors d'un peu d'excel, je suis beaucoup plus habitué au WMI (Windows Management Instrumentation).

Envoyé par Théolude le 23/07/2008 à 10h53

Envoyé par ced600

J'ai remarqué dans les exemples que MS faisait cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Set Info   = CreateObject("ADSystemInfo")
    Set InfoNT = CreateObject("WinNTSystemInfo")
    Set Conn   = CreateObject("ADODB.Connection")
    Set iMsg   = CreateObject("CDO.Message")
    Set iPer   = CreateObject("CDO.Person")
 
    iPer.DataSource.Open "LDAP://" & Info.UserName
    Set iMbx = iPer.GetInterface("IMailbox")

Toi tu fais différement, as tu essayé ainsi pour avoir ton ImailBox (on ne sait jamais).

Je vais essayer de ce pas...
Sinon je viens de prendre le temps de fouiller encore et encore, et je suis tombé là dessus:
http://www.outlookexchange.com/artic...s/pubmetwb.asp
Et aussi là dessus http://gsexdev.blogspot.com/2007/03/...bs-script.html

C'est TRES intéressant dans le cas qui me préoccupe

Envoyé par ced600

Bien que tu utilises le langage VBS, tu fais plus du Windows qu'autres choses
En fait tous ces objets sont présent nativement sur le SE et permette dans ton cas de piloter exchange.
En gros tu récupère un objet déjà existant et instancié, et ensuite tu te balade d'objet en objet qu'il contient, tu récupère ou positionne les valeurs des propriétés, et tu utilises les méthodes disponibles.
Là il te faut plus de la connaissance dans la bibliothèque d'objet que dans le VBS.

Ah je me disais aussi

Merci ça soigne un peu mon ego, je commençais à penser que je devenais idiot, mais en fait c'est plus simple, je ne suis pas aussi tordu que Bill

Bon je continue mes exploration, et je te (vous) tiens au courant. Je poserai le script final dans ce forum à toutes fins utiles.

Théo

Envoyé par Théolude le 25/07/2008 à 11h09

Bonjour,

Mon script progresse, voici la dernière mouture

.
Je parcours l'ensemble des utilisateurs du domaine, je me connecte à leur Calendrier Exchange, je fais une requête dessus, je crée un fichier texte par utilisateur, et j'exporte le tout par FTP sur un serveur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
' [CREATE Theo - 23/07/2008]
' Inspiré très largement d'un script trouvé ici http://www.outlookexchange.com/articles/glenscales/pubmetwb.asp
 
' Debug
' On Error Resume Next
 
'' --------------------------------------------------------------------------------
'' Définition des fonctions
'' --------------------------------------------------------------------------------
Function convertUTC(strDateToConvert, strTimeZoneFrom, strTimeZoneTo)
	Set objCdoAppointment = CreateObject("CDO.Appointment")
	Set objCdoConfiguration = CreateObject("CDO.Configuration")
 
	objCdoAppointment.Configuration = objCdoConfiguration
	objCdoConfiguration.Fields("urn:schemas:calendar:timezoneid").Value = strTimeZoneFrom
	objCdoConfiguration.Fields.Update
 
	objCdoAppointment.StartTime = strDateToConvert
	objCdoConfiguration.Fields("urn:schemas:calendar:timezoneid").Value = strTimeZoneTo
	objCdoConfiguration.Fields.Update
 
	convertUTC = objCdoAppointment.StartTime
End Function
 
'' --------------------------------------------------------------------------------
'' Création des dates au format ISO pour la requête sur Exchange
'' --------------------------------------------------------------------------------
 
' Création des deux dates avec l'interval
intDateStart = convertUTC(Now(), 0, 0)
intDateEnd = convertUTC(Date & " " & TimeValue("23:59:59"), 0, 0)
 
' Récupération de l'année
strYearStart = Year(intDateStart)
strYearEnd = Year(intDateEnd)
 
' Formatage des mois sur deux chiffres
strMonthStart = Month(intDateStart)
strMonthEnd = Month(intDateEnd)
If strMonthStart < 10 Then
	strMonthStart = 0 & strMonthStart
End If
If strMonthEnd < 10 Then
	strMonthEnd = 0 & strMonthEnd
End If
 
' Formatage des jours sur deux chiffres
strDayStart = Day(intDateStart)
strDayEnd = Day(intDateEnd)
If strDayStart < 10 Then
	strDayStart = 0 & strDayStart
End If
If strDayEnd < 10 Then
	strDayEnd = 0 & strDayEnd
End If
 
' Formatage de la chaîne finale
strFormatDateStart = strYearStart & "-" & strMonthStart & "-" & strDayStart & "T" & formatdatetime(intDateStart, 4) & ":" & "00Z"
strFormatDateEnd = strYearEnd & "-" & strMonthEnd & "-" & strDayEnd & "T" & formatdatetime(intDateEnd, 4) & ":" & "00Z"
'' --------------------------------------------------------------------------------
 
'' --------------------------------------------------------------------------------
'' Récupération de la liste des utilisateurs du domaine
'' --------------------------------------------------------------------------------
 
' Connexion LDAP au conteneur des utilisateurs du domaine
Set objConnexionForLdap = CreateObject("ADODB.Connection")
objConnexionForLdap.Open "Provider=ADsDSOObject;"
 
' Construction de la requête et exécution
Set objAdodbCommand = CreateObject("ADODB.Command")
objAdodbCommand.ActiveConnection = objConnexionForLdap
objAdodbCommand.CommandText = "<LDAP://OU=Users,DC=terre-et-decor,DC=local>;(ObjectClass=user);cn,mail,sAMAccountName;subtree"
 
Set objRecordSetLdap = objAdodbCommand.Execute
 
' Parcours des enregistrements
Do Until objRecordSetLdap.EOF
 
	' On construit l'URL qui va permettre de se connecter au compte Exchange de la personne
	strURL = "mail:" & objRecordSetLdap.Fields("mail")
	'' --------------------------------------------------------------------------------
 
	'' --------------------------------------------------------------------------------
	'' Récupération des informations utilisateurs
	'' --------------------------------------------------------------------------------
 
	' Connexion au compte de l'utilisateur via son email
	Set objCdoPerson = CreateObject("CDO.Person")
	Set iMailBox = objCdoPerson.GetInterface("IMailbox")
	Set iPerson = objCdoPerson.GetInterface("IPerson")
 
	objCdoPerson.DataSource.Open strURL
 
	' Récupération de la racine du calendrier de l'utilisateur
	' strCalendarUrl = iMailBox.Calendar
	strCalendarUrl = "file://./backofficestorage/xxxxxxxxxxxxxxxx/MBX/" & objRecordSetLdap.Fields("sAMAccountName") & "/Calendar/"
 
	' Récupération du nom et du prénom de la personne
	' strUserName = iPerson.FirstName & iPerson.LastName
	strUserName = objRecordSetLdap.Fields("cn")
 
	'' --------------------------------------------------------------------------------
 
	'' --------------------------------------------------------------------------------
	'' Requête sur la base Exchange
	'' --------------------------------------------------------------------------------
	Set objRecord = CreateObject("ADODB.Record")
	Set objConnexion = CreateObject("ADODB.Connection")
	Set objRecordSet = CreateObject("ADODB.Recordset")
	objConnexion.Provider = "ExOLEDB.DataSource"
 
	objRecord.Open strCalendarUrl
	objRecordSet.ActiveConnection = objRecord.ActiveConnection
 
	strQuery = "SELECT ""DAV:href"", " & _
		" ""urn:schemas:mailheader:subject"", " & _
		" ""urn:schemas:calendar:dtstart"", " & _
		" ""urn:schemas:calendar:dtend"", " & _
		" ""urn:schemas:calendar:organizer"", " & _
		" ""urn:schemas:calendar:busystatus"", " & _
		" ""urn:schemas:calendar:duration"", " & _
		" ""DAV:contentclass"" " & _
		"FROM scope('shallow traversal of """ & strCalendarUrl & """') " & _
		"WHERE (""urn:schemas:calendar:dtstart"" >= CAST(""" & strFormatDateStart & """ as 'dateTime')) " & _
		"AND (""urn:schemas:calendar:dtend"" <= CAST(""" & strFormatDateEnd & """ as 'dateTime')) " & _
		"AND (""urn:schemas:mailheader:subject"" <> """" " & _
		"AND ""DAV:contentclass"" = 'urn:content-classes:appointment' " & _
		"ORDER BY ""urn:schemas:calendar:dtstart"" ASC"
 
	objRecordSet.Source = strQuery
	'' --------------------------------------------------------------------------------
 
	'' --------------------------------------------------------------------------------
	'' Parcours des enregistrements et création du fichier
	'' --------------------------------------------------------------------------------
 
	' Création de l'objet pour la création du fichier d'export
	Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
	Set objOutPutFile = objFileSystemObject.CreateTextFile(strUserName & ".data", True)
 
	' Lancement de la requête et parcours des enregistrements
	objRecordSet.Open
	If objRecordSet.RecordCount <> 0 Then
		objRecordSet.MoveFirst
 
		While Not objRecordSet.EOF
 
			strSubject = objRecordSet.Fields("urn:schemas:mailheader:subject").Value
			strDateDebut = FormatDateTime(convertUTC(objRecordSet.Fields("urn:schemas:calendar:dtstart").Value, 0, 0), 3)
			strDateFin = FormatDateTime(convertUTC(objRecordSet.Fields("urn:schemas:calendar:dtend").Value, 0, 0), 3)
 
			objOutPutFile.WriteLine strDateDebut & vbTab & strDateFin & vbTab & strSubject
 
			objRecordSet.MoveNext
		Wend
	End If
	objRecordSet.Close
	objOutPutFile.Close
 
	Set objOutPutFile = Nothing
	Set objRecordSet = Nothing
	'' --------------------------------------------------------------------------------
 
	' On part sur l'enregistement LDAP suivant
	objRecordSetLdap.MoveNext
Loop
 
'' --------------------------------------------------------------------------------
'' Export en FTP des fichiers générés
'' --------------------------------------------------------------------------------
 
' Création des objets nécessaires
Set objFtpCmdFile = objFileSystem.CreateTextFile("ftpagenda.cmd", True)
Set shellCmd = WScript.CreateObject("WScript.Shell")
 
' Création du fichier de commandes FTP
With objFtpCmdFile
 .WriteLine "xxxxxxxxxxx"
 .WriteLine "xxxxxxxxxxx"
 .WriteLine "PUT *.data"
 .WriteLine "DISCONNECT"
 .WriteLine "QUIT"
 .Close
End With
 
' On envoie le fichier en FTP et on le supprime du poste
' On attend la fin de l'exécution (option true), et on masque la fenêtre (option 0)
shellCmd.Run "ftp -v -s:ftpagenda.cmd xxxxxxxxxxxxxxx", 0, true
 
' Suppression des fichiers cmd et data (sécurité)
objFileSystem.deleteFile("*.data")
objFileSystem.deleteFile("*.cmd")
'' --------------------------------------------------------------------------------

Le problème se trouve au niveau de ma requête ADODB sur le calendrier d'Exchange :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
strQuery = "SELECT ""DAV:href"", " & _
		" ""urn:schemas:mailheader:subject"", " & _
		" ""urn:schemas:calendar:dtstart"", " & _
		" ""urn:schemas:calendar:dtend"", " & _
		" ""urn:schemas:calendar:organizer"", " & _
		" ""urn:schemas:calendar:busystatus"", " & _
		" ""urn:schemas:calendar:duration"", " & _
		" ""DAV:contentclass"" " & _
		"FROM scope('shallow traversal of """ & strCalendarUrl & """') " & _
		"WHERE (""urn:schemas:calendar:dtstart"" >= CAST(""" & strFormatDateStart & """ as 'dateTime')) " & _
		"AND (""urn:schemas:calendar:dtend"" <= CAST(""" & strFormatDateEnd & """ as 'dateTime')) " & _
		"AND (""urn:schemas:mailheader:subject"" <> """" " & _
		"AND ""DAV:contentclass"" = 'urn:content-classes:appointment' " & _
		"ORDER BY ""urn:schemas:calendar:dtstart"" ASC"

Elle ne me renvoie jamais rien... problème de droits d'accès au calendrier, problème de requête?

Merci de votre aide, Théo

Envoyé par ced600 le 25/07/2008 à 11h42

Elle ne me renvoie jamais rien... problème de droits d'accès au calendrier, problème de requête?

Fait une requête la plus simple et la plus basique possible, même si elle ne fait pas tout ce que tu souhaites. En fonction de la réussite ou non tu pourras déterminer si c ta grosse requête ou un problème de droit qui t'ennuis.

**AlainTech** · 04/08/2008, 02h11

Envoyé par Théolude le 25/07/2008 à 15h08

La requête simplifiée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
strQuery = "SELECT ""DAV:href"", " & _
	" ""urn:schemas:calendar:dtstart"", " & _
	" ""DAV:contentclass"" " & _
	"FROM scope('shallow traversal of """ & iMailBox.Calendar & """') " & _
	"WHERE ""DAV:contentclass"" = 'urn:content-classes:appointment' "

Erreur:
Impossible de trouver l'objet correspondant au nom ou à la référence ordinale demandée.
Code: 800A0CC1

Avec la valeur iMailBox.Calendar = "file://./backofficestorage/xxxxxxxxxxxxxxxxxx/MBX/Administrateur/Calendrier/"

Cette valeur pour mon test a été forcée à la main, mais elle est validée et confirmée par ce script qui me la renvoie construite:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
email = "administrateur@xxxxxxxxxxxxxxxxx"
strURL = "mailto:" & email
 
Set Person = CreateObject("CDO.Person")
Set Mailbox = Person.GetInterface("IMailbox")
Person.DataSource.Open strURL
 
WScript.Echo "URL to inbox for " & email & " is: " & Mailbox.Inbox
WScript.Echo "URL to Calendar for " & email & " is: " & Mailbox.Calendar

D'ailleurs c'est à l'origine ce morceau de code que je voulais utiliser pour récupérer les url exactes des calendriers de mes utilisateurs... mais il ne fonctionne QUE pour le compte identifié (y'a t'il un moyen de contourner?). Ce qui fait que j'ai préféré utiliser une méthode plus robuste en "construisant" cette url à partir de l'identifiant utilisateur récupéré par la requête LDAP.

Bon tout ceci pour dire que ma requête OLDEB sur la BDD Exchange me renvoie rien et que je ne comprends pas pourquoi !!

Merci encore une fois de votre aide. Théo

Envoyé par ced600 le 25/07/2008 à 15h19

Perso j'ai peu confiance en les _ pour les retours à la ligne, et j'essayerais sans mais avec peu d'espoir.

Tu ne peux pas faire une requête sans de imailbox.calendar ?
En gros est ce que tu arrives à faire une requête à ta bdd et qu'elle te renvois quelque chose ?
A moins que cela soit ce que tu me dit là :

Avec la valeur iMailBox.Calendar = "file://./backofficestorage/xxxxxxxxxxxxxxxxxx/MBX/Administrateur/Calendrier/"

Cette valeur pour mon test a été forcée à la main, mais elle est validée et confirmée par ce script qui me la renvoie construite:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
email = "administrateur@xxxxxxxxxxxxxxxxx"
strURL = "mailto:" & email
 
Set Person = CreateObject("CDO.Person")
Set Mailbox = Person.GetInterface("IMailbox")
Person.DataSource.Open strURL
 
WScript.Echo "URL to inbox for " & email & " is: " & Mailbox.Inbox
WScript.Echo "URL to Calendar for " & email & " is: " & Mailbox.Calendar

Cela donne quoi comme résultat, une valeur renvoyé par la requête ? rien du tout ? ou un plantage ?

Envoyé par Théolude le 25/07/2008 à 15h28

Ce script :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Set objRecord = CreateObject("ADODB.Record")
Set objConnexion = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
objConnexion.Provider = "ExOLEDB.DataSource"
 
objRecord.Open "file://./backofficestorage/xxxxxxxxxxxxxxxx/MBX/Administrateur/Calendrier"
objRecordSet.ActiveConnection = objRecord.ActiveConnection
 
strQuery = "SELECT ""DAV:href"", " & _
	" ""DAV:contentclass"" " & _
	"FROM scope('shallow traversal of ""file://./backofficestorage/xxxxxxxxxxxxxxxxxxxxxxxxxx/MBX/Administrateur/Calendrier""') " & _
	"WHERE ""DAV:contentclass"" = 'urn:content-classes:appointment' "
 
objRecordSet.Source = strQuery
 
objRecordSet.Open
WScript.Echo "Nb results = " & objRecordSet.RecordCount

Me renvoie 4... ce qui est juste. Et ce qui prouve que ma requête seule fonctionne, il y a un autre schmilblick...

Envoyé par Théolude le 25/07/2008 à 15h35

Ok vu et corrigé, dans la requête:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"AND ""urn:schemas:mailheader:subject"" <> """" " & _

A la place de:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"AND ""urn:schemas:mailheader:subject"" <> '' " & _

Qui est apparemment mieux accepté (je ne veux que les éléments qui ont un sujet renseigné).

Théo

Envoyé par Théolude le 25/07/2008 à 15h54

Ca y'est le script final....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
' [Theo - 23/07/2008]
' Inspiré très largement d'un script trouvé ici http://www.outlookexchange.com/articles/glenscales/pubmetwb.asp
 
' Debug
' On Error Resume Next
 
'' --------------------------------------------------------------------------------
'' Définition des fonctions
'' --------------------------------------------------------------------------------
Function convertUTC(strDateToConvert, strTimeZoneFrom, strTimeZoneTo)
	Set objCdoAppointment = CreateObject("CDO.Appointment")
	Set objCdoConfiguration = CreateObject("CDO.Configuration")
 
	objCdoAppointment.Configuration = objCdoConfiguration
	objCdoConfiguration.Fields("urn:schemas:calendar:timezoneid").Value = strTimeZoneFrom
	objCdoConfiguration.Fields.Update
 
	objCdoAppointment.StartTime = strDateToConvert
	objCdoConfiguration.Fields("urn:schemas:calendar:timezoneid").Value = strTimeZoneTo
	objCdoConfiguration.Fields.Update
 
	convertUTC = objCdoAppointment.StartTime
End Function
 
'' --------------------------------------------------------------------------------
'' Création des dates au format ISO pour la requête sur Exchange
'' --------------------------------------------------------------------------------
 
' Création des deux dates avec l'interval
intDateStart = convertUTC(Now(), 0, 0)
intDateEnd = convertUTC(Date & " " & TimeValue("23:59:59"), 0, 0)
 
' Récupération de l'année
strYearStart = Year(intDateStart)
strYearEnd = Year(intDateEnd)
 
' Formatage des mois sur deux chiffres
strMonthStart = Month(intDateStart)
strMonthEnd = Month(intDateEnd)
If strMonthStart < 10 Then
	strMonthStart = 0 & strMonthStart
End If
If strMonthEnd < 10 Then
	strMonthEnd = 0 & strMonthEnd
End If
 
' Formatage des jours sur deux chiffres
strDayStart = Day(intDateStart)
strDayEnd = Day(intDateEnd)
If strDayStart < 10 Then
	strDayStart = 0 & strDayStart
End If
If strDayEnd < 10 Then
	strDayEnd = 0 & strDayEnd
End If
 
' Formatage de la chaîne finale
strFormatDateStart = strYearStart & "-" & strMonthStart & "-" & strDayStart & "T" & formatdatetime(intDateStart, 4) & ":" & "00Z"
strFormatDateEnd = strYearEnd & "-" & strMonthEnd & "-" & strDayEnd & "T" & formatdatetime(intDateEnd, 4) & ":" & "00Z"
'' --------------------------------------------------------------------------------
 
'' --------------------------------------------------------------------------------
'' Récupération de la liste des utilisateurs du domaine
'' --------------------------------------------------------------------------------
 
' Connexion LDAP au conteneur des utilisateurs du domaine
Set objConnexionForLdap = CreateObject("ADODB.Connection")
Set objRecordSetLdap = CreateObject("ADODB.Recordset")
Set objAdodbCommand = CreateObject("ADODB.Command")
 
' Construction de la requête et exécution
objConnexionForLdap.Open "Provider=ADsDSOObject;"
objAdodbCommand.ActiveConnection = objConnexionForLdap
objAdodbCommand.CommandText = "<LDAP://OU=Societe,DC=xxxxxxxxxxxxxxxx,DC=local>;(ObjectClass=user);cn,mail,sAMAccountName;subtree"
 
Set objRecordSetLdap = objAdodbCommand.Execute
 
' Parcours des enregistrements
Do Until objRecordSetLdap.EOF
 
	'' --------------------------------------------------------------------------------
	'' Récupération des informations utilisateurs
	'' --------------------------------------------------------------------------------
 
	' Récupération de la racine du calendrier de l'utilisateur
	strCalendarUrl = "file://./backofficestorage/xxxxxxxxxxxxxxxxxx/MBX/" & objRecordSetLdap.Fields("sAMAccountName") & "/Calendrier/"
 
	' Récupération du nom et du prénom de la personne
	' strUserName = iPerson.FirstName & iPerson.LastName
	strUserName = objRecordSetLdap.Fields("cn")
 
	'' --------------------------------------------------------------------------------
 
	'' --------------------------------------------------------------------------------
	'' Requête sur la base Exchange
	'' --------------------------------------------------------------------------------
	Set objRecord = CreateObject("ADODB.Record")
	Set objConnexion = CreateObject("ADODB.Connection")
	Set objRecordSet = CreateObject("ADODB.Recordset")
	objConnexion.Provider = "ExOLEDB.DataSource"
 
	objRecord.Open strCalendarUrl
	objRecordSet.ActiveConnection = objRecord.ActiveConnection
 
	strQuery = "SELECT ""DAV:href"", " & _
		" ""urn:schemas:mailheader:subject"", " & _
		" ""urn:schemas:calendar:dtstart"", " & _
		" ""urn:schemas:calendar:dtend"", " & _
		" ""urn:schemas:calendar:organizer"", " & _
		" ""urn:schemas:calendar:busystatus"", " & _
		" ""urn:schemas:calendar:duration"", " & _
		" ""DAV:contentclass"" " & _
		"FROM scope('shallow traversal of """ & strCalendarUrl & """') " & _
		"WHERE (""urn:schemas:calendar:dtstart"" >= CAST(""" & strFormatDateStart & """ as 'dateTime')) " & _
		"AND (""urn:schemas:calendar:dtend"" <= CAST(""" & strFormatDateEnd & """ as 'dateTime')) " & _
		"AND ""urn:schemas:mailheader:subject"" <> '' " & _
		"AND ""DAV:contentclass"" = 'urn:content-classes:appointment' " & _
		"ORDER BY ""urn:schemas:calendar:dtstart"" ASC"
 
	objRecordSet.Source = strQuery
	'' --------------------------------------------------------------------------------
 
	'' --------------------------------------------------------------------------------
	'' Parcours des enregistrements et création du fichier
	'' --------------------------------------------------------------------------------
 
	' Création de l'objet pour la création du fichier d'export
	Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
	Set objOutPutFile = objFileSystemObject.CreateTextFile(strUserName & ".data", True)
 
	' Lancement de la requête et parcours des enregistrements
	objRecordSet.Open
 
	If objRecordSet.RecordCount <> 0 Then
		objRecordSet.MoveFirst
 
		While Not objRecordSet.EOF
 
			strSubject = objRecordSet.Fields("urn:schemas:mailheader:subject").Value
			strDateDebut = FormatDateTime(convertUTC(objRecordSet.Fields("urn:schemas:calendar:dtstart").Value, 0, 0), 3)
			strDateFin = FormatDateTime(convertUTC(objRecordSet.Fields("urn:schemas:calendar:dtend").Value, 0, 0), 3)
 
			objOutPutFile.WriteLine strDateDebut & vbTab & strDateFin & vbTab & strSubject
 
			objRecordSet.MoveNext
		Wend
	End If
	objRecordSet.Close
	objOutPutFile.Close
 
	Set objOutPutFile = Nothing
	Set objRecordSet = Nothing
	'' --------------------------------------------------------------------------------
 
	' On part sur l'enregistement LDAP suivant
	objRecordSetLdap.MoveNext
Loop
 
'' --------------------------------------------------------------------------------
'' Export en FTP des fichiers générés
'' --------------------------------------------------------------------------------
 
' Création des objets nécessaires
Set objFtpCmdFile = objFileSystem.CreateTextFile("ftpagenda.cmd", True)
Set shellCmd = WScript.CreateObject("WScript.Shell")
 
' Création du fichier de commandes FTP
With objFtpCmdFile
 .WriteLine "xxxxxxxxx"
 .WriteLine "xxxxxxxxx"
 .WriteLine "PUT *.data"
 .WriteLine "DISCONNECT"
 .WriteLine "QUIT"
 .Close
End With
 
' On envoie le fichier en FTP et on le supprime du poste
' On attend la fin de l'exécution (option true), et on masque la fenêtre (option 0)
shellCmd.Run "ftp -v -s:ftpagenda.cmd xxxxxxxxxxxxxxx", 0, true
 
' Suppression des fichiers cmd et data (sécurité)
objFileSystem.deleteFile("*.data")
objFileSystem.deleteFile("*.cmd")
'' --------------------------------------------------------------------------------

Qui fonctionne presque, si ce n'est que je n'arrive pas à me connecter aux calendriers des autres utilisateurs

Certainement un problème de droits ou de méthodes....

Message d'erreur: Impossible de trouver un objet ou une donnée correspondant au nom, à la plage ou aux critères de sélection dans l'étendue de cette opération.
Code: 80040E1

Cette erreur se produit sur la ligne d'ouverture de la connexion ADODB si je tente de me connecter sur le calendrier d'un utilisateur différent de celui qui lance le script.

Une idée?

Théo

**AlainTech** · 04/08/2008, 02h33

Envoyé par ced600 le 25/07/2008 à 16h45

Il faut te connecter à ta base de donnée en tant qu'un autre utilisateur.
Il doit y avoir des propriétés qui te permettte de définir login et pass avant de faire la connection.

Envoyé par Théolude le 28/07/2008 à 09h32

Envoyé par ced600

Il faut te connecter à ta base de donnée en tant qu'un autre utilisateur.

Ok ça je peux y arriver

Envoyé par ced600

Il doit y avoir des propriétés qui te permettte de définir login et pass avant de faire la connection.

Par contre là je suis plus sceptique

En parcourant LDAP je peux récupérer l'identifiant... mais comment récupérer le mot de passe sans que ça puisse constituer un trou de sécurité pour Windows??
Le mot de passe des utilisateurs sur le domaine change tout les 30 jours...

Merci de votre aide, Théo

Envoyé par ced600 le 28/07/2008 à 09h37

Y a pas un compte super admin où tu aurait les droits pour faire cela ?

Envoyé par Théolude le 28/07/2008 à 10h35

Le script s'exécute sous le compte du super administrateur... mais je ne connais aucune méthode pour récupérer les mots de passe des utilisateurs... et ça me semble fou que ça puisse exister

Théo

Envoyé par Théolude le 28/07/2008 à 16h24

Le script complet et fonctionnel.
Il reste à en modifier les paramètres mis en xxxxxxxxxxxxxxxxxxxxx pour l'adapter à votre situation.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
' [Theo - 23/07/2008]
' Inspiré très largement d'un script trouvé ici http://www.outlookexchange.com/articles/glenscales/pubmetwb.asp
 
' On ne veut pas être interrompu par les erreurs, du style un compte utilisateur inaccessible
' On logue les erreurs plus loin
On Error Resume Next
 
'' --------------------------------------------------------------------------------
'' Définition des fonctions
'' --------------------------------------------------------------------------------
Function convertUTC(strDateToConvert, strTimeZoneFrom, strTimeZoneTo)
	Set objCdoAppointment = CreateObject("CDO.Appointment")
	Set objCdoConfiguration = CreateObject("CDO.Configuration")
 
	objCdoAppointment.Configuration = objCdoConfiguration
	objCdoConfiguration.Fields("urn:schemas:calendar:timezoneid").Value = strTimeZoneFrom
	objCdoConfiguration.Fields.Update
 
	objCdoAppointment.StartTime = strDateToConvert
	objCdoConfiguration.Fields("urn:schemas:calendar:timezoneid").Value = strTimeZoneTo
	objCdoConfiguration.Fields.Update
 
	convertUTC = objCdoAppointment.StartTime
End Function
 
'' --------------------------------------------------------------------------------
'' Création des dates au format ISO pour la requête sur Exchange
'' --------------------------------------------------------------------------------
 
' Calcul de la date de départ et de la date de fin
strDateStart = DateAdd("d", +0, Date)
strDateEnd = DateAdd("d", +28, Date) ' Ajout de 28 jours (4 semaines de visibilité)
 
' Création des deux dates au format UTC avec l'interval
intDateStart = convertUTC(strDateStart, 0, 0)
intDateEnd = convertUTC(strDateEnd & " " & TimeValue("23:59:59"), 0, 0)
 
' Récupération de l'année
strYearStart = Year(intDateStart)
strYearEnd = Year(intDateEnd)
 
' Formatage des mois sur deux chiffres
strMonthStart = Month(intDateStart)
strMonthEnd = Month(intDateEnd)
If strMonthStart < 10 Then
	strMonthStart = 0 & strMonthStart
End If
 
If strMonthEnd < 10 Then
	strMonthEnd = 0 & strMonthEnd
End If
 
' Formatage des jours sur deux chiffres
strDayStart = Day(intDateStart)
strDayEnd = Day(intDateEnd)
If strDayStart < 10 Then
	strDayStart = 0 & strDayStart
End If
If strDayEnd < 10 Then
	strDayEnd = 0 & strDayEnd
End If
 
' Formatage de la chaîne finale
strFormatDateStart = strYearStart & "-" & strMonthStart & "-" & strDayStart & "T" & formatdatetime(intDateStart, 4) & ":" & "00Z"
strFormatDateEnd = strYearEnd & "-" & strMonthEnd & "-" & strDayEnd & "T" & formatdatetime(intDateEnd, 4) & ":" & "00Z"
'' --------------------------------------------------------------------------------
 
'' --------------------------------------------------------------------------------
'' Récupération de la liste des utilisateurs du domaine
'' --------------------------------------------------------------------------------
 
' Connexion LDAP au conteneur des utilisateurs du domaine
Set objConnexionForLdap = CreateObject("ADODB.Connection")
Set objRecordSetLdap = CreateObject("ADODB.Recordset")
Set objAdodbCommand = CreateObject("ADODB.Command")
 
' Construction de la requête et exécution
objConnexionForLdap.Open "Provider=ADsDSOObject;"
objAdodbCommand.ActiveConnection = objConnexionForLdap
objAdodbCommand.CommandText = "<LDAP://OU=xxxxxxxxx,DC=xxxxxxxxxxx,DC=xxxxxxx>;(ObjectClass=user);cn,mail,sAMAccountName;subtree"
 
i = 0
Dim tabUsers(200)
Dim strErreur
Set objRecordSetLdap = objAdodbCommand.Execute
 
' Parcours des enregistrements
Do Until objRecordSetLdap.EOF
 
	'' --------------------------------------------------------------------------------
	'' Récupération des informations utilisateurs
	'' --------------------------------------------------------------------------------
 
	' Récupération de la racine du calendrier de l'utilisateur
	strAccount = objRecordSetLdap.Fields("sAMAccountName")
	strCalendarUrl = "file://./backofficestorage/xxxxxxxxxxx/MBX/" & strAccount & "/Calendrier/" 
' Attention, Calendrier dépend de la langue de l'installation, ça peut aussi être Calendar
' Attention également au chemin LDAP :)
 
	'' --------------------------------------------------------------------------------
 
	'' --------------------------------------------------------------------------------
	'' Requête sur la base Exchange
	'' --------------------------------------------------------------------------------
	Set objRecord = CreateObject("ADODB.Record")
	Set objConnexion = CreateObject("ADODB.Connection")
	Set objRecordSet = CreateObject("ADODB.Recordset")
	objConnexion.Provider = "ExOLEDB.DataSource"
 
	objRecord.Open strCalendarUrl
 
	' Détection des erreurs de connexions
	If Err = 0 Then
 
		' Récupération du nom et du prénom de la personne
		strRealUserName = objRecordSetLdap.Fields("cn")
 
		' On remplace les espaces pour créer un nom du fichier utilisable en script FTP
		strUserName = Replace(strRealUserName, " ", "_")
		tabUsers(i) = strUserName
 
		' Connexion
		objRecordSet.ActiveConnection = objRecord.ActiveConnection
 
		' Requête de récupération de l'agenda
		strQuery = "SELECT ""DAV:href"", " & _
			" ""urn:schemas:mailheader:subject"", " & _
			" ""urn:schemas:calendar:dtstart"", " & _
			" ""urn:schemas:calendar:dtend"", " & _
			" ""urn:schemas:calendar:organizer"", " & _
			" ""urn:schemas:calendar:busystatus"", " & _
			" ""urn:schemas:calendar:location"", " & _
			" ""urn:schemas:calendar:alldayevent"", " & _
			" ""DAV:contentclass"" " & _
			"FROM scope('shallow traversal of """ & strCalendarUrl & """') " & _
			"WHERE (""urn:schemas:calendar:dtstart"" >= CAST(""" & strFormatDateStart & """ as 'dateTime')) " & _
			"AND (""urn:schemas:calendar:dtend"" <= CAST(""" & strFormatDateEnd & """ as 'dateTime')) " & _
			"AND ""urn:schemas:mailheader:subject"" <> '' " & _
			"AND ""DAV:contentclass"" = 'urn:content-classes:appointment' " & _
			"ORDER BY ""urn:schemas:calendar:dtstart"" ASC"
 
		objRecordSet.Source = strQuery
 
		If Err = 0 Then
			'' --------------------------------------------------------------------------------
 
			'' --------------------------------------------------------------------------------
			'' Parcours des enregistrements et création du fichier
			'' --------------------------------------------------------------------------------
 
			' Création de l'objet pour la création du fichier d'export
			Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
 
			' Lancement de la requête et parcours des enregistrements
			objRecordSet.Open
 
			If objRecordSet.RecordCount <> 0 Then
 
				Set objOutPutFile = objFileSystemObject.CreateTextFile(strUserName & ".data", True)
				objRecordSet.MoveFirst
 
				While Not objRecordSet.EOF
 
					strSubject = objRecordSet.Fields("urn:schemas:mailheader:subject").Value
					strDateDebut = objRecordSet.Fields("urn:schemas:calendar:dtstart").Value
					strDateFin = objRecordSet.Fields("urn:schemas:calendar:dtend").Value
					strCategories = objRecordSet.Fields("urn:schemas:calendar:busystatus").Value
					strLocation = objRecordSet.Fields("urn:schemas:calendar:location").Value
					boolAllDayEvent = objRecordSet.Fields("urn:schemas:calendar:alldayevent").Value
					strOrganizer = objRecordSet.Fields("urn:schemas:calendar:organizer").Value
 
					' Construction de la ligne DATA à exporter
					strLine = strDateDebut & vbTab & _
							strDateFin & vbTab & _
							strSubject & vbTab & _
							strLocation & vbTab & _
							strCategories & vbTab & _
							boolAllDayEvent & vbTab & _
							strOrganizer
 
					objOutPutFile.WriteLine strLine
 
					objRecordSet.MoveNext
				Wend
 
				objOutPutFile.Close
				Set objOutPutFile = Nothing
			End If
			objRecordSet.Close
 
			' Fin de boucle
			Set objRecordSet = Nothing
			i = i + 1
		Else
			' Gestion des erreurs
			strErreur = strErreur & "Lecture de l'agenda de : " & strUserName & vbTab & Err.Description & vbCrLf
			Err.Clear
		End If
		'' --------------------------------------------------------------------------------
	Else
		' Gestion des erreurs
		strErreur = strErreur & "Accès au compte de : " & strAccount &  vbTab & Err.Description & vbCrLf
		Err.Clear
 
	End If
 
	' On part sur l'enregistement LDAP suivant
	objRecordSetLdap.MoveNext
Loop
 
'' --------------------------------------------------------------------------------
'' Export en FTP des fichiers générés
'' --------------------------------------------------------------------------------
 
' Création des objets nécessaires
Set objFtpCmdFile = objFileSystemObject.CreateTextFile("ftpagenda.cmd", True)
Set shellCmd = WScript.CreateObject("WScript.Shell")
 
' Création du fichier de commandes FTP
With objFtpCmdFile
 .WriteLine "xxxxxxxx" ' User FTP
 .WriteLine "xxxxxxxx" ' Mot de passe FTP
 
 For j = 0 To i
 	.WriteLine "PUT " & tabUsers(j) & ".data"
 Next
 
 .WriteLine "DISCONNECT"
 .WriteLine "QUIT"
 .Close
End With
 
' On envoie le fichier en FTP et on le supprime du poste
' On attend la fin de l'exécution (option true), et on masque la fenêtre (option 0)
shellCmd.Run "ftp -v -s:ftpagenda.cmd xxxxxxurl ftpxxxxxxxx", 0, true
 
' Suppression des fichiers cmd et data (sécurité)
objFileSystemObject.DeleteFile("*.cmd")
objFileSystemObject.DeleteFile("*.data")
'' --------------------------------------------------------------------------------
 
WScript.Echo strErreur

Ce script NE FONCTIONNE PAS ENCORE CHEZ MOI, à priori un problème de droits sur les boîtes à régler, d'où le log des erreurs inscrit dans le programme (vous pouvez l'adapter pour vous les envoyer par email). MAIS IL DOIT ETRE NORMALEMENT 100% FONCTIONNEL.

Si vous avez un tuyau pour m'aider à me dépatouiller de ces histoires de droits je suis preneur...

Théo

[Connexion à Exchange][Récupération des agendas][Util. Objet CDO.Iappointment]

VBScript

Discussions similaires

Partager

Partager