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
|
Option Explicit 'Déclaration obligatoire des variables
'Corps de script
DIM obFolder, objShell, FSO, PATH
'Sub ProcessFolder
DIM obSubFolder, StrFolderName
'Sub Db
DIM obFolder2, nDeFichiers, strParFolderName, obFile, strFileName
DIM strP1Nomfichier, strP2NomFichier, strP3Nomfichier
DIM TnomFichier, StrP2aNomFichier, StrP2bNomFichier
'Corps de script
'Get Application object of the Windows shell.
Set objShell = WScript.CreateObject("Shell.Application")
'Get access to script folder And create the resulting file in it
Set FSO = CreateObject("Scripting.FileSystemObject")
PATH = FSO.GetParentFolderName(wscript.ScriptFullName) & "\"
'Ask the user to select a folder - Répertoire à partir duquel va débuter le traitement
set obFolder = objShell.BrowseForFolder (0,"Select the folder to process",1)
If Not obfolder IS Nothing Then 'si obfolder n'est pas rien!
'MsgBox "1 - je suis la"
ProcessFolder FSO, PATH, obFolder.self.Path
MsgBox "End !" 'à laisser
Else
MsgBox "Cancel" 'à laisser
End If
Sub ProcessFolder(FSO, PATH, FolderPath) 'PATH indispensable
'Get access to the folder
Set obFolder = FSO.GetFolder(FolderPath) 'si actif obfolder devient le chemin!
'Loop on all the subFolders And process each of them
For Each obSubFolder In obFolder.SubFolders
'StrFolderName = FSO.GetParentFolderName (obSubFolder) ' Cette ligne donne le bon rep dans le sub, mais ne fait que Db!
StrFolderName = obSubFolder.Name 'Cette ligne ne donne pas le bon rep dans le sub, mais fait tous les sub!
'MsgBox "Sub Proc fold - repertoire : " & StrFolderName 'liste bien les noms des répertoires
If (InStr(1, StrFolderName, "DB", 1) > 0) Then Db FSO, FolderPath
If (InStr(1, StrFolderName, "LAS20", 1) > 0) Then Las20 FSO, FolderPath
If (InStr(1, StrFolderName, "DI", 1) > 0) Then Di FSO, FolderPath
If (InStr(1, StrFolderName, "DT", 1) > 0) Then Dt FSO, FolderPath
If (InStr(1, StrFolderName, "2018", 1) > 0) Then Gyro FSO, FolderPath 'attention utilisation d'une année!!!!
Next
'Loop on all the subFolders And process each of them
For Each obSubFolder In obFolder.SubFolders
ProcessFolder FSO, PATH, obSubFolder.Path
Next
End Sub
SUB Db (FSO, FolderPath)
MsgBox "Yes ... sub Db!"
'Get access to the folder / Est-ce utile, oui car si non on reste dans le repéertoire précédant!! cf. remarque ci-dessous!!
Set obFolder2 = FSO.GetFolder(FolderPath & "\DB") 'si actif obFolder2 devient le chemin!
strParFolderName = Right(obFolder2, 11)
'Extraire le nom du réppertoire parent qui est en fait le nom du forage de 7 à 8 caractères
If Left (strParFolderName,1) = "\" Then strParFolderName = Mid(strParFolderName,2,7) Else strParFolderName = Mid(strParFolderName,1,8)
'Extraire le nombre de fichier du repertoire
nDeFichiers = FSO.GetFolder(FolderPath& "\DB").Files.Count
'Verifier si nombre paire (en principe toujours 2 fichiers par log dans les DB! un fichier hed et un fichier log
If ((nDeFichiers/2)-CInt(nDeFichiers/2))<>0 Then MsgBox "ATTENTION il y a " & nDeFichiers & " fichiers. C'est un nombre impaire!",16
'Vérifie la première partie du nom
For Each obFile In obFolder2.Files
strFileName = obFile.Name
'Coupe le nom de fichier en utilisant _ comme séparateur (3 parties...)
TnomFichier = Split(obFile.Name,"_",-1)
'Attribut aux variable une partie du non de fichier
strP1Nomfichier = TnomFichier(0)
strP2Nomfichier = TnomFichier(1)
strP3Nomfichier = TnomFichier(2)
If strParFolderName <> strP1Nomfichier Then MsgBox "Sub Db - attention au nom du fichier : " & obFile.Name, 16 '16 affiche message critique ....
'Ajouter une possibilité de correction
'Si pas correction demander si on efface le fichier - Voir si on peut le déplacer dans la corbeille au cas ou!
'voir si on peut revenir en début de boucle
'Vérification de la seconde partie du nom du fichier 8 car ou moins, et avant un_
'Extraction
MsgBox "str a Traiter : " & strP2NomFichier 'Renvoie le bon nom
MsgBox "Debut : " & Left(strP2NomFichier,4) ' renvoie bien DGGG ou DILx ....
MsgBox "Fin : " & Right(strP2NomFichier,4) ' renvoie bien le n° de serie
If (StrComp(Right(strP2NomFichier,4),"DGGG",1) = 0) Then MsgBox "1 - A traiter : " & strP2NomFichier : StrP2aNomFichier = Left(strP2NomFichier,4) AND strP2bNomFichier = Right(strP2NomFichier,4)
MsgBox "2nd partie : " & strP2bNomFichier 'Vide!
If (StrComp(Right(strP2NomFichier,3),"DIL",1) = 0) Then MsgBox "2 - A traiter : " & strP2NomFichier : StrP2aNomFichier = Left(strP2NomFichier,3) AND strP2bNomFichier = Right(strP2NomFichier,4)
MsgBox "2nd partie : " & strP2bNomFichier 'Vide!
If (StrComp(Left(strP2bNomFichier,1),"L",1) = 0) Then MsgBox "3 - A traiter : " & strP2NomFichier : StrP2aNomFichier = Left(strP2NomFichier,3)AND strP2bNomFichier = Right(strP2NomFichier,3)
MsgBox "2nd partie : " & strP2bNomFichier 'Vide!
MsgBox "str a traiter : " & strP2NomFichier 'Ok!!!
MsgBox "sonde : " & StrP2aNomFichier & " N de serie : " & strP2bNomFichier 'Tout est vide ... les lignes 97, 99 et 101 ne fonctionnent pas
'If (InStr(1, strP2NomFichier, "DGGG", 1) = 0) Then MsgBox "1 - A traiter : " & strP2NomFichier : StrP2aNomFichier = Left(strP2NomFichier,4) AND strP2bNomFichier = Right(strP2NomFichier,4) Else
'If (InStr(1, strP2NomFichier, "DIL", 1) = 0) Then MsgBox "2 - A traiter : " & strP2NomFichier : StrP2aNomFichier = Left(strP2NomFichier,3) AND strP2bNomFichier = Right(strP2NomFichier,4) Else
'If (InStr(1, strP2bNomFichier, "L", 1) = 0) Then MsgBox "2 - A traiter : " & strP2NomFichier : StrP2aNomFichier = Left(strP2NomFichier,3) AND strP2bNomFichier = Right(strP2NomFichier,4)
'DGGG passe à la ligne 122 et renvoie type incompatible string DGG! code 800A00D ....
'MsgBox "2nd partie : " & strP2bNomFichier
'MsgBox "str a traiter : " & strP2NomFichier
'MsgBox "sonde : " & StrP2aNomFichier & " N de serie : " & strP2bNomFichier
Next
'En fin de Sub effacement des variables
End Sub
SUB Las20 (FSO, FolderPath)
MsgBox "Yes ... sub Las20!"
'Utiliser une variable obFolderX pour chaque sub!
End Sub
SUB Di (FSO, FolderPath)
MsgBox "Yes ... Sub Di!"
End Sub
SUB Dt (FSO, FolderPath)
MsgBox "Yes ... Sub Dt!"
End Sub
SUB Gyro (FSO, FolderPath)
MsgBox "Yes ... Sub Gyro!"
'Trouver un moyen simple pour aller dans le sous dossier ....
End Sub |
