Se connecter avec
S'enregistrer | Connectez-vous

Erreur 424 [VBS]

Dernière réponse : dans Programmation

Bonjour a tous,
je suis ici pour vous demander un petit coup de patte.

J'ai récupéré sur la toile un script de surveillance de dossier,d'après la description il aurait juste fallu mettre
"X" "Y" ou X est le dossier a surveiller et Y le dossier ou sera créé le fichier de compte-rendu.

Sauf que le script me retourne des erreurs 424 que je vois pas comment résoudre.
Après analyse via vbs factory , il me dit que c'est de cette ligne que découlent toutes les erreurs de mon script.

  1. Set objArgs = Wscript.Arguments


Je ne posterai pas le script en entier pour des raisons de lisibilités (1069 lignes)
mais je peux les mettre si quelqu'un juge cela utile

Cordialement Nego.

Autres pages sur : erreur 424 vbs

Lassé par la pub ? Créez un compte
Expert Programmation

Salut,

Cette ligne me semble particulièrement anodine.
Le libellé associé à l'erreur 424, c'est bien "Objet requis" ?
Si oui, je ne vois pas pourquoi Wscript pose problème puisqu'il n'a pas besoin d'être instancié (c'est MS qui le dit).

Comment lances-tu ton programme ?

Bonjour Zeb,

effectivement cette ligne est tout a fait anodine,

Je lance mon script via un raccourci, le créateur du script indiquait qu'il fallait seulement aller dans propriétés et après le chemin du fichier rajouter le répertoire a surveiller et le répertoire pour le compte rendu

C'est peut être de la que viens le problème même si j'en doute.

Quand au libellé c'est bien "Objet requis".

Si jamais tu as une idée je suis preneur, si tu le souhaites je peux poster une partie plus étendue du script au lieu de cette petite ligne

Vas pour le code complet ;) 


  1. '*****************************************************************************************
    

  2. '*  Programme permettant de lister l'ensemble des données du disque dur et de faire      *
    

  3. '*        un historique des modifications                                                *
    

  4. '*****************************************************************************************
    

  5. '========================================================================================*
    

  6. '=    DATE    !                                                                          *
    

  7. '=------------!--------------------------------------------------------------------------*
    

  8. '= 20/08/2004 !           CREATION DU PROGRAMME                                          *
    

  9. '========================================================================================*
    

  10. '-----------------------------------------------------------------------------------------
    

  11. '-          Déclaration des variables                                                     
    

  12. '-----------------------------------------------------------------------------------------
    

  13. Dim ObjetFso, Resultat
    

  14. Dim ObjTextFicRef
    

  15. Dim ErrNumber, ErrSource, ErrDescription, PremiereExecution
    

  16. Dim NbreFichierSansAcces, Titre, NbreFichiertrouver, HeureDebut, FicHisto
    

  17. Dim NbreFicCreer, NbreFicModif, NbreFicSup, dateTravail
    

  18. Dim PresenceMAJ
    

  19. Dim FicAnalyser, RepTravail, FicCptRendu, FicComp, FicCompTemp, FicRef, FicRefTemp
    

  20. 'Const FicRef 			= "D:\REF-LDQ.txt"
    

  21. 'Const FicRefTemp 		= "D:\REF-LDQ-Temp.txt"
    

  22. 'Const RepTravail		= "D:\"
    

  23. 'Const FicCptRendu		= "D:\CptRendu-LDQ.txt"
    

  24. 'Const FicComp			= "D:\COMP-LDQ.TXT"
    

  25.  
  26. 'Const RepTravail		= "D:\"
    

  27. 'Const FicCptRendu		= "D:\CptRendu-LDQ.txt"
    

  28. 'Const FicComp			= "D:\COMP-LDQ.TXT"
    

  29. 'Const FicCompTemp		= "D:\COMP-LDQ-temp.TXT"
    

  30. 'Const FicXml 			= "RESULTAT-LDQ.XML"
    

  31. 'Const FicRef 			= "D:\REF-LDQ.txt"
    

  32. 'Const FicRefTemp 		= "D:\REF-LDQ-Temp.txt"
    

  33. 'Const FicAnalyser 		= "D:\kuthf"
    

  34. Const ForReading 		= 1
    

  35. Const ForWriting 		= 2
    

  36. Const ForAppending 		= 8
    

  37. Const TristateUsedefault = -2
    

  38. Const TristateTrue 		= -1
    

  39. Const TristateFalse 	= 0
    

  40. Const PosFic			= 66 'Position du premier caractère contenant le nom du fichier
    

  41. '					dans le fichier de reférence
    

  42. Const Limitetime 		= 0.001
    

  43.  
  44.  
  45. '-----------------------------------------------------------------------------------------
    

  46. '-          initialisation des variables                                                  
    

  47. '-----------------------------------------------------------------------------------------
    

  48. Set ObjetFso 	= CreateObject("Scripting.FileSystemObject")
    

  49. HeureDebut 	= FormatDateTime(Time(),vbLongTime)
    

  50. dateTravail 	= Date()
    

  51. PresenceMAJ 	= "False"
    

  52.  
  53. '-----------------------------------------------------------------------------------------
    

  54. '-             corps du programme                                                         
    

  55. '-----------------------------------------------------------------------------------------
    

  56. ProcPrincipale
    

  57. Titre = "Compte rendu d'exécution" & Chr(13) & Chr(10)
    

  58. Message = Chr(9) & "- Nombre de fichier non traité par manque d'autorisation : " _
    

  59. 	& NbreFichierSansAcces & Chr(13) & Chr(10) & Chr(9) _
    

  60. 	& "- Nombre de fichier " & " trouver et ecrit : " & NbreFichiertrouver
    

  61.  
  62. MsgBox(Titre & Message)
    

  63.  
  64. '=========================================================================================
    

  65. '=                Procedure principale                                                   =
    

  66. '=========================================================================================
    

  67.  
  68. Sub ProcPrincipale
    

  69. 	Dim Source, Destination
    

  70. 	NomProcedureFonction = "Sub ProcPrincipale"
    

  71. '	--> Récupération des arguments;
    

  72.  
  73. 	Set objArgs = Wscript.Arguments
    

  74. 	If objArgs.Count <> 2 Then
    

  75. 		NomProcedureFonction = "Test des arguments en entree."
    

  76. 		AfficheMessageErreur NomProcedureFonction,8
    

  77. 		Resultat = "False"
    

  78. 		Exit Sub
    

  79. 	End If
    

  80. 	FicAnalyser 	= objArgs(0)
    

  81. 	RepTravail 	= objArgs(1)
    

  82. 	FicCptRendu	= RepTravail & "CptRendu-LDQ.txt"
    

  83. 	FicComp		= RepTravail & "COMP-LDQ.TXT"
    

  84. 	FicCompTemp	= RepTravail & "COMP-LDQ-temp.TXT"
    

  85. 	FicRef 		= RepTravail & "REF-LDQ.txt"
    

  86. 	FicRefTemp 	= RepTravail & "REF-LDQ-Temp.txt"
    

  87.  
  88. 'MsgBox("FicCptRendu : " & FicCptRendu)
    

  89.  
  90. 'Cinématique de la procédure:
    

  91. '===========================
    

  92. '	--> Test des arguments en entrée
    

  93. '	--> Suppression du fichier de comparaison
    

  94. '	--> Suppression du fichier de comparaison temporaire
    

  95. '	--> Suppression du fichier de référence temporaire
    

  96. '	--> Création du fichier Historique à partir du fichier de référence
    

  97. '		--> Suppression du fichier de référence
    

  98.  
  99. '-----------------------------------------------------------------------------------------
    

  100. '-               Suppression du fichier de comparaison                                   -
    

  101. '-----------------------------------------------------------------------------------------
    

  102. '	MsgBox("SupFic(FicComp)")
    

  103. 	Resultat = SupFic(FicComp)
    

  104. 	If Resultat = "False" Then
    

  105. 		Exit Sub
    

  106. 	End If
    

  107.  
  108. '-----------------------------------------------------------------------------------------
    

  109. '-               Suppression du fichier de comparaison temporaire                        -
    

  110. '-----------------------------------------------------------------------------------------
    

  111. '	MsgBox("SupFic(FicCompTemp)")
    

  112. 	Resultat = SupFic(FicCompTemp)
    

  113. 	If Resultat = "False" Then
    

  114. 		Exit Sub
    

  115. 	End If
    

  116.  
  117. '-----------------------------------------------------------------------------------------
    

  118. '-               Suppression du fichier temporaire                                       -
    

  119. '-----------------------------------------------------------------------------------------
    

  120. '	MsgBox("SupFic(FicRefTemp)")
    

  121. 	Resultat = SupFic(FicRefTemp)
    

  122. 	If Resultat = "False" Then
    

  123. 		Exit Sub
    

  124. 	End If
    

  125.  
  126. '-----------------------------------------------------------------------------------------
    

  127. '-               test l'existance du fichier de reference                                -
    

  128. '-----------------------------------------------------------------------------------------
    

  129. '	MsgBox("Test Existance du fichier de référence")
    

  130. 	If ObjetFso.FileExists(FicRef) Then
    

  131. '		--->  Création du fichier historique à partir du fichier de référence
    

  132. '		MsgBox("CopieFicRef(FicRef,ObjetFso,RepTravail)")
    

  133. 		Resultat = CopieFicRef(FicRef,ObjetFso,RepTravail)
    

  134. 		If Resultat = "False" Then
    

  135. 			Exit Sub
    

  136. 		End If
    

  137. '		--->  Suppression du fichier de référence
    

  138. '		MsgBox("ObjetFso.DeleteFile FicRef,True")
    

  139. 		ObjetFso.DeleteFile FicRef,True
    

  140. 		If err.Number > 0 Then
    

  141. 			AfficheMessageErreur NomProcedureFonction,0
    

  142. 			Exit Sub
    

  143. 		End If
    

  144. 		PremiereExecution = "False"
    

  145. 	Else
    

  146. 		PremiereExecution = "True"
    

  147. 	End If
    

  148.  
  149. '-----------------------------------------------------------------------------------------
    

  150. '-               Création du fichier de référence                                        -
    

  151. '-----------------------------------------------------------------------------------------
    

  152. '	MsgBox("Création du fichier de référence")
    

  153. 	Set FileObjRef = ObjetFso.OpenTextFile(FicRef,ForAppending,True,TristateUseDefault)
    

  154. 	Resultat = ListeRep(FicAnalyser,FileObjRef)
    

  155. 	If Resultat = "True" Then
    

  156. '		MsgBox("Vrai")
    

  157. 	End If
    

  158. 	If Resultat = "False" Then
    

  159. '		MsgBox("Faux")
    

  160. 	End If
    

  161.  
  162. 	FileObjRef.Close
    

  163. 	Set FileObjRef = Nothing
    

  164.  
  165. '-----------------------------------------------------------------------------------------
    

  166. '-               Suppression du fichier temporaire                                       -
    

  167. '-----------------------------------------------------------------------------------------
    

  168. '	MsgBox("Suppression du fichier temporaire")
    

  169. 	Resultat = SupFic(FicRefTemp)
    

  170. 	If Resultat = "False" Then
    

  171. 		Exit Sub
    

  172. 	End If
    

  173.  
  174. '-----------------------------------------------------------------------------------------
    

  175. '-               Tri du fichier de référence par une commande DOS                        -
    

  176. '-----------------------------------------------------------------------------------------
    

  177. '	MsgBox("TrieFichier")
    

  178. 	Resultat = TrieFichier(FicRef,66,FicRefTemp)
    

  179. 	If Resultat = "False" Then
    

  180. 		Exit Sub
    

  181. 	End If
    

  182.  
  183. '-----------------------------------------------------------------------------------------
    

  184. '-               Test l'existence du fichier de référence temporaire                     -
    

  185. '-----------------------------------------------------------------------------------------
    

  186. '	MsgBox("TestExistanceFic(FicRefTemp)")
    

  187. 	Resultat = TestExistanceFic(FicRefTemp)
    

  188. 	If Resultat = "False" Then
    

  189. 		Exit Sub
    

  190. 	End If
    

  191.  
  192. '-----------------------------------------------------------------------------------------
    

  193. '-               Suppression du fichier Référence                                        -
    

  194. '-----------------------------------------------------------------------------------------
    

  195. '	MsgBox("SupFic(FicRef)")
    

  196. 	Resultat = SupFic(FicRef)
    

  197. 	If Resultat = "False" Then
    

  198. 		Exit Sub
    

  199. 	End If
    

  200.  
  201. '-----------------------------------------------------------------------------------------
    

  202. '-     Copie du fichier référence temporaire a la place du fichier reference             -
    

  203. '-----------------------------------------------------------------------------------------
    

  204. '	MsgBox("CopyFic(FicRefTemp, FicRef)")
    

  205. 	Resultat = CopyFic(FicRefTemp, FicRef)
    

  206. 	If Resultat = "False" Then
    

  207. 		Exit Sub
    

  208. 	End If
    

  209.  
  210. '-----------------------------------------------------------------------------------------
    

  211. '-               Suppression du fichier Référence temporaire                             -
    

  212. '-----------------------------------------------------------------------------------------
    

  213. '	MsgBox("SupFic(FicRefTemp)")
    

  214. 	Resultat = SupFic(FicRefTemp)
    

  215. 	If Resultat = "False" Then
    

  216. 		Exit Sub
    

  217. 	End If
    

  218.  
  219. '-----------------------------------------------------------------------------------------
    

  220. '-               Comparaison de 2 documents                                              -
    

  221. '-----------------------------------------------------------------------------------------
    

  222.  
  223. 	If PremiereExecution = "False" Then
    

  224. 		CompareDocument
    

  225. 	End If
    

  226. '-----------------------------------------------------------------------------------------
    

  227. '-               Tri du fichier de comparaison par une commande DOS                      -
    

  228. '-----------------------------------------------------------------------------------------
    

  229. 	If PresenceMAJ = "True" Then
    

  230. 		Resultat = TrieFichier(FicComp,1,FicCompTemp)
    

  231. 		If Resultat = "False" Then
    

  232. 			Exit Sub
    

  233. 		End If
    

  234. 	End If
    

  235. '-----------------------------------------------------------------------------------------
    

  236. '-               Teste l'existence du fichier de comparaison temporaire                   -
    

  237. '-----------------------------------------------------------------------------------------
    

  238. 	If PresenceMAJ = "True" Then
    

  239. '		MsgBox("TestExistanceFic(FicCompTemp)")
    

  240. 		Resultat = TestExistanceFic(FicCompTemp)
    

  241. 		If Resultat = "False" Then
    

  242. 			Exit Sub
    

  243. 		End If
    

  244. 	End If
    

  245.  
  246. '-----------------------------------------------------------------------------------------
    

  247. '-               Création du fichier XML                                                -
    

  248. '-----------------------------------------------------------------------------------------
    

  249. 	If PremiereExecution = "False" Then
    

  250. '			MsgBox("CreationXml")
    

  251. 		CreationXml
    

  252. 	End If
    

  253.  
  254. '-----------------------------------------------------------------------------------------
    

  255. '-               Suppression du fichier de référence temporaire                          -
    

  256. '-----------------------------------------------------------------------------------------
    

  257. '	MsgBox("SupFic(FicRefTemp)")
    

  258. 	Resultat = SupFic(FicRefTemp)
    

  259. 	If Resultat = "False" Then
    

  260. 		Exit Sub
    

  261. 	End If
    

  262.  
  263. '-----------------------------------------------------------------------------------------
    

  264. '-               Création du compte rendu d'exécution                                    -
    

  265. '-----------------------------------------------------------------------------------------
    

  266. 	CreationCompteRendu 
    

  267. End Sub
    

  268. '=========================================================================================
    

  269. '=                            Fonction                                                   =
    

  270. '=========================================================================================
    

  271.  
  272. '-----------------------------------------------------------------------------------------
    

  273. '        Fonction permettant de Tester l'existance d'un fichier                          -
    

  274. '-----------------------------------------------------------------------------------------
    

  275. Function TestExistanceFic(Fichier)
    

  276. Dim Debut, Fin
    

  277.  
  278. Dim Compteur
    

  279. On Error Resume Next
    

  280. 	Debut = Time
    

  281. 	Compteur = 0
    

  282. 	NomProcedureFonction = "Function TestExistanceFic(Fichier) avec Fichier = " & Fichier
    

  283. 	Do 
    

  284. 		Compteur = Compteur + 1
    

  285. 		Fin = Time
    

  286. 		If Err.Number > 0 Then
    

  287. 			ErrNumber 	= Err.Number
    

  288. 			ErrSource 	= Err.Source
    

  289. 			ErrDescription 	= Err.Description
    

  290. 			AfficheMessageErreur NomProcedureFonction,0
    

  291. 			TestExistanceFic = "False"
    

  292. 		End If
    

  293. 		Temp = Fin - Debut
    

  294. 		If Temp >= Limitetime Then
    

  295. 			AfficheMessageErreur NomProcedureFonction,6
    

  296. 			TestExistanceFic = "False"
    

  297. 			Exit Do
    

  298. 		End If
    

  299. 	Loop Until ObjetFso.FileExists(Fichier) = True
    

  300.  
  301. End Function
    

  302.  
  303. '-----------------------------------------------------------------------------------------
    

  304. '        Fonction permettant de Copier un fichier                                        -
    

  305. '-----------------------------------------------------------------------------------------
    

  306. Function CopyFic(Source, Destination)
    

  307. On Error Resume Next
    

  308. 	NomProcedureFonction = "Function CopyFic(Source, Destination) avec Source = " _
    

  309. 		& Source & " Destination = " & Destination
    

  310. 	ObjetFso.CopyFile Source, Destination, True
    

  311. 	If Err.Number > 0 Then
    

  312. 		ErrNumber 	= Err.Number
    

  313. 		ErrSource 	= Err.Source
    

  314. 		ErrDescription 	= Err.Description
    

  315. 		AfficheMessageErreur NomProcedureFonction,0
    

  316. 		CopyFic = "False"
    

  317. 	End If
    

  318. End Function
    

  319.  
  320. '-----------------------------------------------------------------------------------------
    

  321. '        Fonction permettant de Supprimer un fichier                                     -
    

  322. '-----------------------------------------------------------------------------------------
    

  323. Function SupFic(Fichier)
    

  324. On Error Resume Next
    

  325. 	NomProcedureFonction = "Function SupFic(Fchier) avec Fichier = " & Fichier
    

  326. 	ObjetFso.DeleteFile Fichier, True
    

  327. 	If Err.Number > 0 Then
    

  328. 		If Err.number = 53 Then
    

  329. '			AfficheMessageErreur NomProcedureFonction,2
    

  330. 			SupFic = "True"
    

  331. 		Else
    

  332. 			ErrNumber 	= Err.Number
    

  333. 			ErrSource 	= Err.Source
    

  334. 			ErrDescription = Err.Description
    

  335. 			AfficheMessageErreur NomProcedureFonction,0
    

  336. 			SupFic = "False"
    

  337. 		End If
    

  338. 	End If
    

  339. End Function
    

  340.  
  341. '-----------------------------------------------------------------------------------------
    

  342. '        Fonction permettant de faire une lecture de fichier                             -
    

  343. '-----------------------------------------------------------------------------------------
    

  344. Function LectureFic(ObjFile)
    

  345. On Error Resume Next
    

  346. 	NomProcedureFonction = "Function LectureFic(ObjFile)"
    

  347. 	LectureFic = ObjFile.Readline
    

  348. 	If Err.Number > 0 Then
    

  349. 		ErrNumber 	= Err.Number
    

  350. 		ErrSource 	= Err.Source
    

  351. 		ErrDescription = Err.Description
    

  352. 		AfficheMessageErreur NomProcedureFonction,0
    

  353. 		CopieFicRef = "False"
    

  354. 		Exit Function
    

  355. 	End If
    

  356. End Function
    

  357.  
  358. '-----------------------------------------------------------------------------------------
    

  359. '        Fonction permettant de faire le trie dans le fichier de référence               -
    

  360. '-----------------------------------------------------------------------------------------
    

  361. Function TrieFichier(Source,Position,Destination)
    

  362. On Error Resume Next
    

  363. Dim Commande
    

  364. 	NomProcedureFonction = "Function TrieFichier(Source,Position,Destination), avec " _
    

  365. 		& "Source: " & Source & ", Position : " & Position & ", Destination : " _
    

  366. 		 & Destination
    

  367. 	Set Objshell = CreateObject("WScript.Shell")
    

  368. 	Commande = "cmd /k SORT /+" & Position & " " & Source & " /O " & Destination
    

  369.  
  370. 	Resultat = ObjShell.run(Commande,1,true)
    

  371. '	MsgBox("Shell.run Commande,0 = " & Resultat)
    

  372. 	Set Objshell = Nothing
    

  373. 	If Err.Number > 0 Then
    

  374. 		ErrNumber 	= Err.Number
    

  375. 		ErrSource 	= Err.Source
    

  376. 		ErrDescription = Err.Description
    

  377. 		AfficheMessageErreur NomProcedureFonction,0
    

  378. 		TrieFichier = "False"
    

  379. 		Exit Function
    

  380. 	End If
    

  381. End Function
    

  382.  
  383. '-----------------------------------------------------------------------------------------
    

  384. '-       Fonction permettant de récupérer l'ensemble des fichiers et répertoire           
    

  385. '-----------------------------------------------------------------------------------------
    

  386. Function ListeRep(folderspec,ObjText)
    

  387. On Error Resume Next
    

  388. '	MsgBox("ListeRep(folderspec,ObjText)")
    

  389. 	NomProcedureFonction = "Function ListeRep(folderspec,ObjText) avec folderspec = "
    

  390. 	Set ObjetFolder = ObjetFso.GetFolder(folderspec)
    

  391. 	Set ObjSubFolder = ObjetFolder.SubFolders
    

  392. 	Resultat = ListeFic(ObjetFolder,ObjText,folderspec)
    

  393. 	If Resultat = "False" Then
    

  394. 		ListeRep = "False"
    

  395. 		Exit Function
    

  396. 	End If
    

  397.  
  398. 	If Resultat = "False" Then
    

  399. 		ListeRep = "False"
    

  400. 		Exit Function
    

  401. 	End If
    

  402. 	For Each f1 in ObjSubFolder
    

  403. 		RepCourant = folderspec & f1.name
    

  404. 		RepActuel = folderspec & f1.name & "\"
    

  405. 		Set ObjetFolder1 = ObjetFso.GetFolder(RepActuel)
    

  406. 		Set ObjSubFolder1 = ObjetFolder1.SubFolders
    

  407. 		Resultat = ListeRep(RepActuel,ObjText)
    

  408. 		If Resultat = "False" Then
    

  409. 			ListeRep = "False"
    

  410. 			Exit Function
    

  411. 		End If
    

  412. 	Next
    

  413. '	MsgBox("Fin ListeRep(folderspec,ObjText)")
    

  414. End Function
    

  415.  
  416. '-----------------------------------------------------------------------------------------
    

  417. '- Fonction permettant de copier le fichier de référence vers le fichier d'historisation -
    

  418. '-----------------------------------------------------------------------------------------
    

  419. Function CopieFicRef(Source,ObjFso,RepCopie)
    

  420. Dim Destination, DateJour, HeureJour
    

  421. On Error Resume Next
    

  422. 	CopieFicRef = "True"
    

  423. 	NomProcedureFonction = "Function CopieFicRef(Source,ObjFso,RepCopie), avec Source : " _
    

  424. 		& Source & ", RepCopie : " & RepCopie
    

  425. '-----------------------------------------------------------------------------------------
    

  426. '-                    Détermination du nom du fichier de référence                       -
    

  427. '-----------------------------------------------------------------------------------------
    

  428. 	Destination= "HISTO-" & Year(Date()) & FormatNombre(Month(Date()),2) _
    

  429. 		& FormatNombre(Day(Date()),2) & "-" & FormatNombre(Hour(Now()),2) _
    

  430. 		& FormatNombre(Minute(Now()),2) & FormatNombre(Second(Now()),2) & ".txt"
    

  431. 	FicHisto = Destination
    

  432. '-----------------------------------------------------------------------------------------
    

  433. '-                    teste l'existence du fichier d'historisation                       -
    

  434. '-----------------------------------------------------------------------------------------
    

  435. 	If Err.Number > 0 Then
    

  436. 		ErrNumber 	= Err.Number
    

  437. 		ErrSource 	= Err.Source
    

  438. 		ErrDescription 	= Err.Description
    

  439. 		AfficheMessageErreur NomProcedureFonction,0
    

  440. 		CopieFicRef = "False"
    

  441. 		Exit Function
    

  442. 	End If
    

  443.  
  444. 	NomComplet = RepCopie & Destination
    

  445. 	If ObjFso.FileExists(NomComplet) Then
    

  446. 		AfficheMessageErreur NomProcedureFonction,4
    

  447. 		CopieFicRef = "False"
    

  448. 		Exit Function
    

  449. 	End If
    

  450. 	ObjFso.CopyFile Source, NomComplet, False
    

  451. 	If Err.Number > 0 Then
    

  452. 		ErrNumber = Err.Number
    

  453. 		ErrDescription = Err.Description
    

  454. 		ErrSource = Err.source
    

  455. 		AfficheMessageErreur NomProcedureFonction,0
    

  456. 		CopieFicRef = "False"
    

  457. 		Exit Function
    

  458. 	End If
    

  459. End Function
    

  460.  
  461. '-----------------------------------------------------------------------------------------
    

  462. '- Fonction permettant de lister les fichiers d'un répertoire et de ses sous repertoire  -
    

  463. '-----------------------------------------------------------------------------------------
    

  464.  
  465. Function ListeFic(ObjFolder,ObjText,Texte)
    

  466. Dim ObjetFichier, CollectionFichier
    

  467. Dim DateCreation, DateModification, TailleFic, NomFichier
    

  468. Dim TabNomFichier()
    

  469. On Error Resume Next
    

  470. 	NomProcedureFonction = "Function ListeFic(ObjFolder,ObjText,Texte)"
    

  471. 	Set ObjetFichier = ObjFolder.Files
    

  472. 	For Each CollectionFichier in ObjetFichier
    

  473. 		If IsEmpty(CollectionFichier.DateCreated) = True Then
    

  474. 			DateCreation 		= "01/01/0001 00:00:00"
    

  475. 		Else
    

  476. 			DateCreation 		= CollectionFichier.DateCreated
    

  477. 		End If
    

  478. 		If Len(DateCreation)< 15 Then
    

  479. 			DateCreation = DateCreation & " 00:00:00"
    

  480. 		End If
    

  481. 		If IsEmpty(CollectionFichier.DateLastModified) = True Then
    

  482. 			DateModification	= "01/01/0001"
    

  483. 		Else
    

  484. 			DateModification 	= CollectionFichier.DateLastModified
    

  485. 		End If
    

  486. 		If Len(DateModification)< 15 Then
    

  487. 			DateModification = DateModification & " 00:00:00"
    

  488. 		End If
    

  489. 		If IsEmpty(CollectionFichier.DateLastModified) = True Then
    

  490. 			TailleFic 		= 0
    

  491. 		Else
    

  492. 			TailleFic 		= CollectionFichier.size
    

  493. 		End If
    

  494. 		NomFichier		= CollectionFichier.Name
    

  495. 		If NomFichier <> "" Then
    

  496. 			TailleFic 		= FormatNombre(TailleFic,15)
    

  497. 			If TailleFic = "False" Then
    

  498. 				ListeFic = "False"
    

  499. 				MsgBox("erreur pour l'enregistrement : " _
    

  500. 					& CollectionFichier.Name)
    

  501. 				Exit Function
    

  502. 			End If
    

  503. '		--> Suppression des caractères indésirables
    

  504. 			TailleNomFichier = Len(NomFichier)
    

  505. 			ReDim TabNomFichier(TailleNomFichier-1)
    

  506. 			For i=0 To TailleNomFichier - 1
    

  507. 				TabNomFichier(i)=Mid(NomFichier,i+1,1)
    

  508. 				If TabNomFichier(i) = "&" Then
    

  509. 					TabNomFichier(i) = " "
    

  510. 				End If
    

  511. 			Next
    

  512.  
  513. 			NomFichier = ""
    

  514. 			For i=0 To TailleNomFichier - 1
    

  515. 				NomFichier = NomFichier &  TabNomFichier(i)
    

  516. 			Next
    

  517.  
  518. 			Resultat = EcritureLigne(ObjText, DateCreation & " -- " _
    

  519. 				& DateModification & " -- " & TailleFic _
    

  520. 				& " -- " & Texte & NomFichier)
    

  521. 			NbreFichiertrouver = NbreFichiertrouver + 1
    

  522. 		Else
    

  523. 			NbreFichierSansAcces = NbreFichierSansAcces + 1
    

  524. 		End If
    

  525. 	Next
    

  526. End Function
    

  527. '-----------------------------------------------------------------------------------------
    

  528. '-               Formatage d'un chiffre sur X caractères                                  
    

  529. '-----------------------------------------------------------------------------------------
    

  530.  
  531. Function FormatNombre(Chiffre, NombreCar)
    

  532. On Error Resume Next
    

  533. Dim NbreCarChiffre
    

  534. 	NomProcedureFonction = "Function FormatNombre(Chiffre, NombreCar) avec Chiffre = " _
    

  535. 		& Chiffre & ", et NombreCar = " & NombreCar
    

  536. 	If (Chiffre = "") or (NombreCar = "") Then
    

  537. 		AfficheMessageErreur NomProcedureFonction,3
    

  538. 		FormatNombre = "False"
    

  539. 		Exit Function
    

  540. 	End If
    

  541. 	If (not IsNumeric(Chiffre)) or (not IsNumeric(NombreCar)) Then
    

  542. 		AfficheMessageErreur NomProcedureFonction,2
    

  543. 		FormatNombre = "False"
    

  544. 		Exit Function
    

  545. 	End If
    

  546. 	NbreCarChiffre = Len(Chiffre)
    

  547. 	If NbreCarChiffre < NombreCar Then
    

  548. 		For ind01 = 1 to NombreCar - NbreCarChiffre
    

  549. 			ResultatTemp = ResultatTemp & "0"
    

  550. 		Next
    

  551. 		FormatNombre = ResultatTemp & Chiffre
    

  552. 	Else
    

  553. 		FormatNombre = Chiffre
    

  554. 	End If
    

  555. 	If Err.Number > 0 Then
    

  556. 		ErrNumber 	= Err.Number
    

  557. 		ErrSource 	= Err.Source
    

  558. 		ErrDescription = Err.Description
    

  559. 		AfficheMessageErreur NomProcedureFonction,0
    

  560. 		FormatNombre 	= "False"
    

  561. 		Exit Function
    

  562. 	End If
    

  563. End Function
    

  564.  
  565. '-----------------------------------------------------------------------------------------
    

  566. '-       Fonction permettant d'écrire une ligne dans un fichier                          -
    

  567. '-----------------------------------------------------------------------------------------
    

  568.  
  569. Function EcritureLigne(ObjText,Text)
    

  570. On Error Resume Next
    

  571. 	NomProcedureFonction = "Function EcritureLigne(ObjText,Text), avec text: " & Text
    

  572. 	EcrireLigne = ObjText.WriteLine(Text)
    

  573. 	If Err.Number > 0 Then
    

  574. 		ErrNumber 	= Err.Number
    

  575. 		ErrSource 	= Err.Source
    

  576. 		ErrDescription 	= Err.Description
    

  577. 		AfficheMessageErreur NomProcedureFonction,0
    

  578. 	End If
    

  579. End Function
    

  580.  
  581. '-----------------------------------------------------------------------------------------
    

  582. '-       Fonction permettant de centrer un texte sur une longueur total de caractère     -
    

  583. '-----------------------------------------------------------------------------------------
    

  584.  
  585. Function CentreLigne(Texte,NbreCar)
    

  586. On Error Resume Next
    

  587. 	NomProcedureFonction = "Function CentreLigne(Texte,NbreCar) avec Texte: " & Texte _
    

  588. 		& ", NbreCar: " & NbreCar
    

  589. '-----------------------------------------------------------------------------------------
    

  590. '                 Test si le nombre de caractère est numérique                           -
    

  591. '-----------------------------------------------------------------------------------------
    

  592. 	If IsNumeric(NbreCar) = "False" Then
    

  593. 		AfficheMessageErreur NomProcedureFonction,2
    

  594. 		CentreLigne 	= "False"
    

  595. 		Exit Function
    

  596. 	End If
    

  597. 	LongueurblancTotal = NbreCar - Len(Texte)
    

  598. 	CentreLigne = Texte
    

  599. 	If LongueurblancTotal mod 2 > 0 Then 
    

  600. '  on a un chiffre impaire, donc on rajoute (LongueurblancTotal/2)+1 blanc devant
    

  601. 		For ind = 1 to Int(LongueurblancTotal/2) + 1
    

  602. 			CentreLigne = " " & CentreLigne
    

  603. 		Next
    

  604. 	Else
    

  605. 		For ind = 1 to Int(LongueurblancTotal/2)
    

  606. 			CentreLigne = " " & CentreLigne
    

  607. 		Next
    

  608. 	End If
    

  609. End Function
    

  610. '=========================================================================================
    

  611. '=                            Procedure                                                  =
    

  612. '=========================================================================================
    

  613.  
  614. '-----------------------------------------------------------------------------------------
    

  615. '-   Procédure permettant de comparer le fichier de référence au dernier fichier créer   -
    

  616. '-----------------------------------------------------------------------------------------
    

  617. Sub CreationXml
    

  618. Dim Entete, LecComp, EtatFichier, LecXml
    

  619. Dim EtatAjtTrouver, EtatSupTrouver, EtatModTrouver
    

  620. Dim Text, NbrLigneXml01, NbrLigneXml02, NbrLigne
    

  621. Dim FileObjXml, FileObjXml01, FileObjXml02
    

  622. Const TextAbsMaj = "Il n'y a pas de Mise a jour depuis la derniere execution"
    

  623. On Error Resume Next
    

  624. '***********           POUR TEST
    

  625. '	PresenceMAJ = "True"
    

  626. '************
    

  627. 	EtatFichier = "Premier"
    

  628. 	EtatFichierPrec = EtatFichier
    

  629. 	NomProcedureFonction = "Sub CreationXml"
    

  630. 	EtatAjtTrouver = "False"
    

  631. 	EtatSupTrouver = "False"
    

  632. 	EtatModTrouver = "False"
    

  633. 	AvantDernierLigne = "False"
    

  634. 	NumLigneTrouve = "False"
    

  635. 	NbrLigneXml01 = 0
    

  636. 	NbrLigneXml02 = 0
    

  637. 	NbrLigne = 0
    

  638. '--->  Arrivé ici, cela signifie que l'on va créer le fichier XML et que ce n'est pas la 
    

  639. '          première exécution.
    

  640.  
  641. 	If ObjetFso.FileExists(RepTravail & FicXml)= True Then
    

  642. 		Entete = "True"
    

  643. 	Else
    

  644. 		Entete = "False"
    

  645. 	End If
    

  646.  
  647. '--> On supprime la dernière ligne du fichier UNIQUEMENT si ce n'est pas la première
    

  648. '		fois que l'on écrit dans le fichier
    

  649. '	---> Pour Supprimer la ligne "</RESULTAT>":
    

  650. '		--> Supprimer le fichier XML temporaire
    

  651. '		--> Copier le fichier XML vers le fichier XML temporaire
    

  652. '		--> Faire la lecture du fichier temporaire et ne pas copier le ligne
    

  653. '				"</RESULTAT>"
    

  654. '		--> Supprimer le fichier XML temporaire
    

  655. '		--> Fermeture du fichier XML
    

  656. 	If Entete = "True" Then
    

  657. '		--> Supprimer le fichier XML temporaire
    

  658. 		If ObjetFso.FileExists(RepTravail & FicXml & "temp")= True Then
    

  659. 			Resultat = SupFic(RepTravail & FicXml & "temp")
    

  660. 		End If
    

  661. '		--> Copier le fichier XML vers le fichier XML temporaire
    

  662. 		Resultat = CopyFic(RepTravail & FicXml, RepTravail & FicXml & "temp")
    

  663. '		--> Déclaraton du fichier XML et XML temp
    

  664. 		Set ObjFicXmlTmp = ObjetFso.OpenTextFile(RepTravail & FicXml & "temp",ForReading,TristateUseDefault)
    

  665. 		Set ObjFicXml = ObjetFso.OpenTextFile(RepTravail & FicXml,ForWriting,True)
    

  666.  
  667. 		Do Until ObjFicXmlTmp.AtEndOfLine = True
    

  668. 			LecXmlTmp = LectureFic(ObjFicXmlTmp)
    

  669. 			If LecXmlTmp <> "</RESULTAT>" Then
    

  670. 				Resultat = EcritureLigne(ObjFicXml,LecXmlTmp)
    

  671. 			End If
    

  672. 		Loop
    

  673. 		ObjFicXmlTmp.close
    

  674. 		ObjFicXml.close
    

  675. 		Set ObjFicXmlTmp = Nothing
    

  676. 		Set ObjFicXml = Nothing
    

  677. 	End If
    

  678. '	--> Suppression du fichier Xml temporaire
    

  679. 	Resultat = SupFic(RepTravail & FicXml & "temp")
    

  680. 	If Resultat = "False" Then
    

  681. 		Exit Sub
    

  682. 	End If
    

  683.  
  684.  
  685. 	Set FileObjXml = ObjetFso.OpenTextFile(RepTravail & FicXml,ForAppending,True,TristateUseDefault)
    

  686. 	Set FileObjCompTemp = ObjetFso.OpenTextFile(FicCompTemp,ForReading,TristateUseDefault)
    

  687.  
  688. '--->    Ici on sait si le fichier existait avant, le fichier XML est créé automatiquement
    

  689. '            lors de la déclaration du fichier
    

  690. 	If Entete = "False" Then
    

  691. 		Text = "<?xml version='1.0' encoding='iso-8859-1' ?>"
    

  692. 		'le script sort une erreur 424 non résolue'
    

  693. 		Resultat = EcritureLigne(FileObjXml,Text)
    

  694. 		If resultat = "False" Then
    

  695. 			Exit Sub
    

  696. 		End If
    

  697. 		Text = "<RESULTAT>"
    

  698. 		'erreur 424 ici également'
    

  699. 		Resultat = EcritureLigne(FileObjXml,Text)
    

  700. 		If resultat = "False" Then
    

  701. 			Exit Sub
    

  702. 		End If
    

  703. 	End If
    

  704. '	---> Ecriture de la balise de date dans tous les cas
    

  705. 	Text = "<DATE>" & dateTravail & " " & HeureDebut
    

  706. 	'erreur 424'
    

  707. 	Resultat = EcritureLigne(FileObjXml,Text)
    

  708. 	If Resultat = "False" Then
    

  709. 		Exit Sub
    

  710. 	End If
    

  711.  
  712. 	If PresenceMAJ = "False" Then
    

  713. 'Ecriture de la balise du jour
    

  714. '		MsgBox("Ecriture de la notification d'abscence de mis à jours")
    

  715. 		Text = "<NOTA>" & TextAbsMaj & "</NOTA></DATE>"
    

  716. 		Resultat = EcritureLigne(FileObjXml,Text)
    

  717. 		If resultat = "False" Then
    

  718. 			Exit Sub
    

  719. 		End If
    

  720. 		Text = "</RESULTAT>"
    

  721. 		Resultat = EcritureLigne(FileObjXml,Text)
    

  722. 		If resultat = "False" Then
    

  723. 			Exit Sub
    

  724. 		End If
    

  725. 		Exit Sub
    

  726. 	End If
    

  727. 'Ecriture des fichiers
    

  728. 	Do 
    

  729. 		LecComp = LectureFic(FileObjCompTemp)
    

  730. 		EtatFichier = Mid(LecComp,1,5)
    

  731.  
  732. 		Select Case EtatFichier
    

  733. 			Case "<MOD>"
    

  734. 				If EtatFichier <> EtatFichierPrec Then
    

  735. 					If EtatFichierPrec <> "Premier" Then
    

  736. 						Select Case EtatFichierPrec
    

  737. 							Case "<MOD>"
    

  738. 								Text = "</MOD>"
    

  739. 							Case "<AJT>"
    

  740. 								Text = "</AJT>"
    

  741. 							Case "<SUP>"
    

  742. 								Text = "</SUP>"
    

  743. 						End Select
    

  744. 						Resultat = EcritureLigne(FileObjXml,Text)
    

  745. 					End If
    

  746. 				End If
    

  747. 				If EtatModTrouver = "False" Then
    

  748. 					Text = "<MOD>" & Mid(LecComp,6)
    

  749. 					Resultat = EcritureLigne(FileObjXml,Text)
    

  750. 					EtatModTrouver = "True"
    

  751. 				Else
    

  752. 					Text = Mid(LecComp,6)
    

  753. 					Resultat = EcritureLigne(FileObjXml,Text)
    

  754. 				End If
    

  755. 			Case "<SUP>"
    

  756. 				If EtatFichier <> EtatFichierPrec Then
    

  757. 					If EtatFichierPrec <> "Premier" Then
    

  758. 						Select Case EtatFichierPrec
    

  759. 							Case "<MOD>"
    

  760. 								Text = "</MOD>"
    

  761. 							Case "<AJT>"
    

  762. 								Text = "</AJT>"
    

  763. 							Case "<SUP>"
    

  764. 								Text = "</SUP>"
    

  765. 						End Select
    

  766. 						Resultat = EcritureLigne(FileObjXml,Text)
    

  767. 					End If
    

  768. 				End If
    

  769. 				If EtatSupTrouver = "False" Then
    

  770. '					Text = "<SUP><NOM>" & Mid(LecComp,6) & "</NOM>"
    

  771. 					Text = "<SUP>" & Mid(LecComp,6)
    

  772. 					Resultat = EcritureLigne(FileObjXml,Text)
    

  773. 					EtatSupTrouver = "True"
    

  774. 				Else
    

  775. '					Text = "<NOM>" & Mid(LecComp,6) & "</NOM>"
    

  776. 					Text = Mid(LecComp,6)
    

  777. 					Resultat = EcritureLigne(FileObjXml,Text)
    

  778. 				End If
    

  779. 			Case "<AJT>"
    

  780. 				If EtatFichier <> EtatFichierPrec Then
    

  781. 					If EtatFichierPrec <> "Premier" Then
    

  782. 						Select Case EtatFichierPrec
    

  783. 							Case "<MOD>"
    

  784. 								Text = "</MOD>"
    

  785. 							Case "<AJT>"
    

  786. 								Text = "</AJT>"
    

  787. 							Case "<SUP>"
    

  788. 								Text = "</SUP>"
    

  789. 						End Select
    

  790. 						Resultat = EcritureLigne(FileObjXml,Text)
    

  791. 					End If
    

  792. 				End If
    

  793. 				If EtatAjtTrouver = "False" Then
    

  794. 					Text = "<AJT>" & Mid(LecComp,6)
    

  795. 					Resultat = EcritureLigne(FileObjXml,Text)
    

  796. 					EtatAjtTrouver = "True"
    

  797. 				Else
    

  798. 					Text = Mid(LecComp,6)
    

  799. 					EtatAjtTrouver = EcritureLigne(FileObjXml,Text)
    

  800. 				End If
    

  801. 		End Select
    

  802. 		If Resultat = "False" Then
    

  803. 			Exit Sub
    

  804. 		End If
    

  805. 		EtatFichierPrec = EtatFichier
    

  806. 	Loop Until FileObjCompTemp.AtEndOfLine = True
    

  807. '---  Ajout de la fin de la dernier balise
    

  808. 	Select Case EtatFichierPrec
    

  809. 		Case "<MOD>"
    

  810. 			Text = "</MOD>"
    

  811. 		Case "<AJT>"
    

  812. 			Text = "</AJT>"
    

  813. 		Case "<SUP>"
    

  814. 			Text = "</SUP>"
    

  815. 	End Select
    

  816. 	Resultat = EcritureLigne(FileObjXml,Text)
    

  817. 	If Resultat = "False" Then
    

  818. 		Exit Sub
    

  819. 	End If
    

  820. 	Text = "<STAT><NBRAJT>" & NbreFicCreer & "</NBRAJT>" & "<NBRMOD>" _
    

  821. 		& NbreFicModif & "</NBRMOD><NBRSUP>" & NbreFicSup & "</NBRSUP></STAT></DATE>"
    

  822. 	Resultat = EcritureLigne(FileObjXml,Text)
    

  823. 	If Resultat = "False" Then
    

  824. 		Exit Sub
    

  825. 	End If
    

  826. 	Text = "</RESULTAT>"
    

  827. 	Resultat = EcritureLigne(FileObjXml,Text)
    

  828. 	If Resultat = "False" Then
    

  829. 		Exit Sub
    

  830. 	End If
    

  831.  
  832.  
  833. 	FileObjXml.close
    

  834. 	FileObjCompTemp.Close
    

  835. 	If Err.Number > 0 Then
    

  836. 		ErrNumber 	= Err.Number
    

  837. 		ErrSource 	= Err.Source
    

  838. 		ErrDescription 	= Err.Description
    

  839. 		AfficheMessageErreur NomProcedureFonction,0
    

  840. 		Exit Sub
    

  841. 	End If
    

  842.  
  843. End Sub
    

  844.  
  845. '-----------------------------------------------------------------------------------------
    

  846. '-   Procédure permettant de comparer le fichier de référence au dernier fichier créer   -
    

  847. '-----------------------------------------------------------------------------------------
    

  848. Sub CompareDocument
    

  849. Dim LecR, LecH, FicR, FicH
    

  850. Dim FileObjHisto, FileObjRef, FileObjComp
    

  851. Dim LectureFicR, LectureFicH
    

  852. Dim DateCreationR, DateModificationR, TailleFichierR
    

  853. Dim DateCreationH, DateModificationH, TailleFichierH
    

  854. On Error Resume Next
    

  855. 	NomProcedureFonction = "Sub CompareDocument"
    

  856. '	--> Déclaration des fichiers & initialisation des variables
    

  857. 	Set FileObjHisto = ObjetFso.OpenTextFile(RepTravail & FicHisto,ForReading,TristateUseDefault)
    

  858. 	Set FileObjRef = ObjetFso.OpenTextFile(FicRef,ForReading,TristateUseDefault)
    

  859. 	Set FileObjComp = ObjetFso.OpenTextFile(FicComp,ForAppending,True,TristateUseDefault)
    

  860. 	LectureFicR = "True"
    

  861. 	LectureFicH = "True"
    

  862.  
  863. '---Lecture des fichiers
    

  864. 	LecR = LectureFic(FileObjRef)
    

  865. 	FicR = Mid(LecR, 66)
    

  866. 	LecH = LectureFic(FileObjHisto)
    

  867. 	FicH = Mid(LecH, 66)
    

  868. 	While FileObjRef.AtEndOfLine <> True And FileObjHisto.AtEndOfLine <> True
    

  869. '-- Test si un fichier a été ajouter 
    

  870. 		If LCase(FicR) < LCase(FicH) Then
    

  871. 			PresenceMAJ = "True"
    

  872. 			Text = "<AJT><NOM>" & FicR & "</NOM>"
    

  873. 			NbreFicCreer = NbreFicCreer + 1
    

  874. 			Result = EcritureLigne(FileObjComp,Text)
    

  875. 			Do 
    

  876. 				LecR = LectureFic(FileObjRef)
    

  877. 				FicR = Mid(LecR, 66)
    

  878. 				If LCase(FicR) < LCase(FicH) Then
    

  879. 					Text = "<AJT><NOM>" & FicR & "</NOM>"
    

  880. 					Result = EcritureLigne(FileObjComp,Text)
    

  881. 					NbreFicCreer = NbreFicCreer + 1
    

  882. 				Else 
    

  883. 					LectureFicR = "False"
    

  884. 					LectureFicH = "True"
    

  885. 				End If
    

  886. 			Loop Until LCase(FicR) >= LCase(FicH) or FileObjRef.AtEndOfLine = True
    

  887. 		Else
    

  888. '-- Test si un fichier a été supprimer 
    

  889. 			If LCase(FicR) > LCase(FicH) Then
    

  890. 				PresenceMAJ = "True"
    

  891. 				Text = "<SUP><NOM>" & FicH & "</NOM>"
    

  892. 				Result = EcritureLigne(FileObjComp,Text)
    

  893. 				NbreFicSup = NbreFicSup + 1
    

  894. 				Do
    

  895. 					LecH = LectureFic(FileObjHisto)
    

  896. 					FicH = Mid(LecH, 66)
    

  897. 					If LCase(FicR) > LCase(FicH) Then
    

  898. 						Text = "<SUP><NOM>" & FicH & "</NOM>"
    

  899. 						Result = EcritureLigne(FileObjComp,Text)
    

  900. 						NbreFicSup = NbreFicSup + 1
    

  901. 					Else 
    

  902. 						LectureFicH = "False"
    

  903. 						LectureFicR = "True"
    

  904. 						Exit Do
    

  905. 					End If
    

  906. 				Loop Until LCase(FicH) >= LCase(FicR) or FileObjHisto.AtEndOfLine = True
    

  907. 			Else
    

  908. '-- Test si FicH = FicR
    

  909. 				If LCase(FicR) = LCase(FicH) Then
    

  910. 					LectureFicR 		= "True"
    

  911. 					LectureFicH 		= "True"
    

  912. 					DateCreationR 		= Mid(LecR, 1, 19)
    

  913. 					DateModificationR 	= Mid(LecR, 24, 19)
    

  914. 					TailleFichierR 	= Mid(LecR, 47, 15)
    

  915. 					DateCreationH 		= Mid(LecH, 1, 19)
    

  916. 					DateModificationH 	= Mid(LecH, 24, 19)
    

  917. 					TailleFichierH		= Mid(LecH, 47, 15)
    

  918. '-- Test si les fichiers ont été modifiés
    

  919. 					If (DateModificationR <> DateModificationH)_
    

  920. 							or (DateCreationR <> DateCreationH) _
    

  921. 							or (TailleFichierR <> TailleFichierH) Then
    

  922. 						PresenceMAJ = "True"
    

  923. 						Text = "<MOD><NOM>" & FicH
    

  924. 						NbreFicModif = NbreFicModif + 1
    

  925. 						If TailleFichierR <> TailleFichierH Then
    

  926. 							Text = Text & "<MODTAILLE>" _
    

  927. 								& "<TAILLE-AV>" & TailleFichierH & "</TAILLE-AV>" _
    

  928. 								& "<TAILLE-AP>" & TailleFichierR & "</TAILLE-AP>" _
    

  929. 								& "</MODTAILLE>" 
    

  930. 						End If
    

  931. 						If DateCreationR <> DateCreationH Then
    

  932. 							Text = Text & "<MODDTCR>" _
    

  933. 								& "<DATECR-AV>" & DateCreationH & "</DATECR-AV>" _
    

  934. 								& "<DATECR-AP>" & DateCreationR & "</DATECR-AP>" _
    

  935. 								& "</MODDTCR>" 
    

  936. 						End If
    

  937. 						If DateModificationR <> DateModificationH Then
    

  938. 							Text = Text & "<MODDTMO>" _
    

  939. 								& "<DATEMO-AV>" & DateModificationH & "</DATEMO-AV>" _
    

  940. 								& "<DATEMO-AP>" & DateModificationR & "</DATEMO-AP>" _
    

  941. 								& "</MODDTMO>" 
    

  942. 						End If
    

  943. 						Text = Text & "</NOM>"
    

  944. 						Result = EcritureLigne(FileObjComp,Text)
    

  945.  
  946. 					End If
    

  947. 					LecR 			= LectureFic(FileObjRef)
    

  948. 					FicR 			= Mid(LecR, 66)
    

  949. 					LecH 			= LectureFic(FileObjHisto)
    

  950. 					FicH 			= Mid(LecH, 66)
    

  951. 				Else
    

  952. 				PresenceMAJ = "False"
    

  953. 				End If
    

  954. 			End If
    

  955. 		End If
    

  956. 	Wend
    

  957. 	FileObjHisto.close
    

  958. 	FileObjRef.Close
    

  959. 	FileObjComp.Close
    

  960. 	Set FileObjHisto = Nothing
    

  961. 	Set FileObjRef = Nothing
    

  962. 	Set FileObjComp = Nothing
    

  963.  
  964. End Sub
    

  965.  
  966. '-----------------------------------------------------------------------------------------
    

  967. '-       Procedure permettant de créeer le compte rendu d'exécution                      -
    

  968. '-----------------------------------------------------------------------------------------
    

  969. Sub CreationCompteRendu
    

  970. Dim FileObjCpt, TabCptRendu(24)
    

  971. Const TailleLigne = 100
    

  972. On Error Resume Next
    

  973. 	NomProcedureFonction = "Sub CreationCompteRendu"
    

  974. '-----------------------------------------------------------------------------------------
    

  975. '-  Création d'un tableau contenant l'ensemble des lignes à écrire dans le compte rendu  -
    

  976. '-----------------------------------------------------------------------------------------
    

  977.  
  978. 	For ind = 1 to 48 
    

  979. 		TabCptRendu(0) = TabCptRendu(0) & "*"
    

  980. 	Next
    

  981. 	TabCptRendu(0) = CentreLigne(TabCptRendu(0),TailleLigne)
    

  982. 	TabCptRendu(1) = "*    COMPTE RENDU D'EXECUTION DU " & FormatNombre(Day(Date()),2) _
    

  983. 		& "/" & FormatNombre(Month(Date()),2) & "/" & Year(Date()) & "    *"
    

  984. 	TabCptRendu(1) = CentreLigne(TabCptRendu(1),TailleLigne)
    

  985. 	TabCptRendu(2) = TabCptRendu(0)
    

  986. 	TabCptRendu(3) = ""
    

  987. 	TabCptRendu(4) = TabCptRendu(3)
    

  988. 	TabCptRendu(5) = Chr(9) & "- DATE D'EXECUTION                                        : " _
    

  989. 		& FormatDateTime(Date(),vbLongDate)
    

  990. 	TabCptRendu(6) = TabCptRendu(3)
    

  991. 	TabCptRendu(7) = Chr(9) & "- HEURE DE DEBUT D'EXECUTION                              : " _
    

  992. 		& HeureDebut
    

  993. 	TabCptRendu(8) = TabCptRendu(3)
    

  994. 	TabCptRendu(9) = Chr(9) & "- HEURE DE FIN D'EXECUTION                                : " _
    

  995. 		& FormatDateTime(Time(),vbLongTime)
    

  996. 	TabCptRendu(10) = TabCptRendu(3)
    

  997. 	TabCptRendu(11) = Chr(9) & "- NOMBRE DE FICHIERS LISTEES                              : " _
    

  998. 		& NbreFichiertrouver
    

  999. 	TabCptRendu(12) = TabCptRendu(3)
    

  1000. 	TabCptRendu(13) = Chr(9) & "- NOMBRE DE FICHIERS N'AYANT PAS PU ETRE ACCEDE           : " _
    

  1001. 		& NbreFichierSansAcces
    

  1002. 	TabCptRendu(14) = TabCptRendu(3)
    

  1003. 	TabCptRendu(15) = Chr(9) & "- NOM DU FICHIER HISTORIQUE CREER                         : " _
    

  1004. 		& FicHisto
    

  1005. 	TabCptRendu(16) = TabCptRendu(3)
    

  1006. 	TabCptRendu(17) = Chr(9) & "- NOMBRE DE FICHIER CREE DEPUIS LA DERNIERE EXECUTION     : " _
    

  1007. 		& NbreFicCreer
    

  1008. 	TabCptRendu(18) = TabCptRendu(3)
    

  1009. 	TabCptRendu(19) = Chr(9) & "- NOMBRE DE FICHIER MODIFIE DEPUIS LA DERNIERE EXECUTION  : " _
    

  1010. 		& NbreFicModif
    

  1011. 	TabCptRendu(20) = TabCptRendu(3)
    

  1012. 	TabCptRendu(21) = Chr(9) & "- NOMBRE DE FICHIER SUPPRIME DEPUIS LA DERNIERE EXECUTION : " _
    

  1013. 		& NbreFicSup
    

  1014. 	TabCptRendu(22) = TabCptRendu(3)
    

  1015. 	For ind = 1 to TailleLigne 
    

  1016. 		TabCptRendu(23) = TabCptRendu(23) & "="
    

  1017. 	Next
    

  1018. 	TabCptRendu(24) = TabCptRendu(3)
    

  1019. '	MsgBox(FicCptRendu)
    

  1020. 	Set FileObjCpt = ObjetFso.OpenTextFile(FicCptRendu,ForAppending,True,TristateUseDefault)
    

  1021. 	For ind = 0 to UBound(TabCptRendu,1)
    

  1022. 		resultat = EcritureLigne(FileObjCpt,TabCptRendu(ind))
    

  1023. 	Next
    

  1024. 	If Err.Number > 0 Then
    

  1025. 		ErrNumber 	= Err.Number
    

  1026. 		ErrSource 	= Err.Source
    

  1027. 		ErrDescription = Err.Description
    

  1028. 		AfficheMessageErreur NomProcedureFonction,0
    

  1029. 		Exit Sub
    

  1030. 	End If
    

  1031.  
  1032. End Sub
    

  1033.  
  1034.  
  1035. '-----------------------------------------------------------------------------------------
    

  1036. '-       Procedure permettant d'afficher les messages                                     
    

  1037. '-----------------------------------------------------------------------------------------
    

  1038.  
  1039. Sub AfficheMessageErreur(Fonction,NumErreur)
    

  1040. On Error Resume Next
    

  1041. 	Dim TabMessageErreur(10)
    

  1042. 	Dim Message
    

  1043. '               Liste des message d'erreur     
    

  1044. 	TabMessageErreur(0) = Chr(9) & "- Origine de la source d'erreur: " & ErrSource _
    

  1045. 		& Chr(13) & Chr(10) & Chr(9) & "- Numéro de l'erreur : " & ErrNumber _
    

  1046. 		& Chr(13) & Chr(10) & Chr(9) & "- Description de l'erreur : " & ErrDescription
    

  1047. 	TabMessageErreur(1) = "Erreur de lecture dans l'écriture du fichier"
    

  1048. 	TabMessageErreur(2) = "L'une des variables passées en paramètre de la fonction " _
    

  1049. 		& "n'est pas numérique"
    

  1050. 	TabMessageErreur(3) = "Tous les paramètres obligatoires ne sont pas alimentés"
    

  1051. 	TabMessageErreur(4) = "Le fichier historique existe déjà, Arrêt du programme sans suppression" _
    

  1052. 		& "du fichier de référence."
    

  1053. 	TabMessageErreur(5) = "Le fichier temporaire n'existe pas"
    

  1054. 	TabMessageErreur(6) = "Le Temp impartie est dépassé"
    

  1055. 	TabMessageErreur(7) = "Le nombre de fichier lu dans le fichier XML est différentes entre " _
    

  1056. 		& "les 2 dernière lecture"
    

  1057. 	TabMessageErreur(8) = "Les paramètres en entrée sont en nombre insuffisant." & Chr(13) _
    

  1058. 		& Chr(10) & "Pour exécuter le Script,il faut le lancer avec les paramètres suivants: " _
    

  1059. 		& " Surveillance.vbs 'X''Y' où" & Chr(13) & Chr(10) & Chr(9) & " - X: Représente " _
    

  1060. 		& " le disque à analyser." & Chr(13) & Chr(10) & Chr(9) & " - Y: le reperoire où " _
    

  1061. 		& "seront créés les fichiers de résultats."
    

  1062. 	If (1 =< NumErreur =< UBound(TabMessageErreur,1)) = False Then
    

  1063. 		Numerreur = 0
    

  1064. 	End If
    

  1065. 	Message = "Erreur dans la " & Fonction & "." & Chr(13) & Chr(10) _
    

  1066. 		& TabMessageErreur(NumErreur)
    

  1067.  
  1068. 	MsgBox(Message)
    

  1069. End Sub



Et le créateur du script n'a pas donné signe de vie depuis 2004 Alors :D  Je pense qu'il a du déserté et que ça fait longtemps qu'il a laissé son script a la merci de tous ^^
Lassé par la pub ? Créez un compte

Créer un nouveau sujet