Bonjour,
Je viens vers vous avec une question trivial ... mais dont je ne me sort pas.

Je cherche à faire un script pour vérifier des noms de fichiers.

Ces noms doivent tous être au même format et contenir +/- les mêmes informations. Ils sont du type (du moins en partie) :
FFFFXXXB_SSS(S)XXX(X)_AAMMDD_U/DN avec :
FFFFXXXB : Nom du forage (4 lettres) et n° du forage (3 chiffres) et un B dans le cas des forages bis.
SSS(S)XXX(X) : Sonde (mnémonique 3/4 lettres) et n° de série (3/4 chiffres),
AAMMDD : Date au format Année, Mois, Jour,
U/D : U pour log UP (à la montée) et D pour log down (à la descente),
N : nombre de 1 à n. Facultatif, n’est utilisé que si l’on est obligé de faire plusieurs enregistrements avec la même sonde, à la descente
et/ou à la montée.

Les fichiers quand a eux sont répartis, en fonction de leurs types et contenu dans divers répertoires et sous répertoires.
- L’ensemble des données est rangé dans un répertoire DATA
- Il contient les sous répertoires suivant :
o Un répertoire par forage
 Un répertoire DB
 Un répertoire DI
 Un répertoire DT
 Un répertoire GYRO

Pour le moment j’en suis au début ... et je reviens à l’écriture après une longue absence et une toute petite expérience précédente.

Mon script sait parcourir les répertoires et extraire le nom du forage.

Je bute dans mon premier Sub sur l’extraction des données de la seconde partie du nom.
J’ai essayé 2 manières différentes et aucune ne fonctionne pas.
- La première ligne 85 à 89
- La seconde ligne 94 à 96 en remarque '

Les MsgBox me servent à voir si j’ai les bonnes informations et ce qui est donné aux lignes 82 à 84 est bon ...

Mais ce sont les lignes mentionnés qui M.... Pouvez vous me dire ou se trouve le problème, Je vous remercie par avance, du fond du désert, pour votre aide.

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
 
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