| 12
 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
 
 | 'Get Application object of the Windows shell.
Set objShell = WScript.CreateObject("Shell.Application")
 
'Ask the user to select a folder
Set obFolder = objShell.BrowseForFolder (0, "Select the folder to process", 1)
'Wscript.Echo "obFolder = " & obFolder 'réponse ok, me donne le nom du bon répertoire ....
Set obFolder2 = obFolder 'y-a-t il un moyen plus élegant que d'utiliser cette ligne?!
'Wscript.Echo "obFolder2 =" & obFolder2 'idem ci dessus
 
If NOT obFolder IS Nothing Then
 
	'Start WellCAD
	Set WCAD = CreateObject("WellCAD.Application")
	WCAD.ShowWindow()
 
	'Get access to input folder and process it
	'file saveAs avec ajout de _xx à la fin du nom
	Set FSO = CreateObject("Scripting.FileSystemObject")
 
	'SaveAs les ancien fichier avec _XX à la fin
	ProcessFolder WCAD, FSO, obFolder.self.Path
 
	'Suprime les anciens fichiers sans _XX à la fin
	Set obFolder = obFolder2
	'Wscript.Echo "obFolder =" & obFolder 'me donne le bon chemin de départ
	DeleteOldFiles FSO, obFolder.self.Path
 
	'Renomme les fichiers _XX et les effaces
	Set obFolder = obFolder2
	'Wscript.Echo "obFolder =" & obFolder 'me donne le bon chemin de départ
	Renomme_XX FSO, obFolder.self.Path
 
 
	MsgBox "Finished"
 
Else
 
	MsgBox "Canceled"
 
End If
 
 
Sub ProcessFolder(WCAD, FSO, FolderPath) 'supression de PATH
 
	'Get access to the folder
	Set obFolder = FSO.GetFolder(FolderPath)
	'Wscript.Echo obFolder 'me retourne différent path :
	'retourne l'arboresence, travail dans chaque rep ou il faut
	'puis retourne le rep suivant
	'et ainsi de suite
	'
	'Loop on all the files and process each of them
	For Each obFile In obFolder.Files
 
		'Check if it is a WCL file containing diagraphie in its name
		If (StrComp(Right(obFile.Name, 3), "wcl", 1) = 0) AND _
			(InStr(1, obFile.Name, "_xx", 1) = 0) THEN
 
			Set obBHDoc = WCAD.OpenBorehole(obFile.Path)
 
			'SaveAs the WCL file
			obBHDoc.SaveAs Left(obFile.Path, Len(obFile.Path) - 4) & "_xx" & Right(obFile.Path, 4)
 
 
			Set obBHDoc = Nothing
			WCAD.CloseBorehole FALSE
 
		End If
 
	Next
 
	'Loop on all the subfolders and process each of them
	For Each obSubFolder In obFolder.SubFolders
		ProcessFolder WCAD, FSO, obSubFolder.Path 'supression de PATH
	Next
 
End Sub
 
'Suprime les anciens fichiers sans _XX à la fin
Sub DeleteOldFiles (FSO, FolderPath)
 
'Get access to the folder
	Set obFolder = FSO.GetFolder(FolderPath)
 
	'Loop on all the files and process each of them
	For Each obFile In obFolder.Files
 
		If (StrComp(Right(obFile.Name, 3), "wcl", 1) = 0) AND _
		   (InStr(1, obFile.Name, "_xx", 1) = 0) Then
		    'Wscript.echo obFile.name 'donne le bon nom de fichier
			'Wscript.echo obFolder 'donne le bon chemin mais sans le \ à la fin
 
 
		FSO.Deletefile(obfile.path)
 
		End If
 
	Next
 
	'Loop on all the subfolders and process each of them
	For Each obSubFolder In obFolder.SubFolders
		DeleteOldfiles FSO, obSubFolder.Path
	Next
 
End Sub
 
'Renomme les anciens fichiers sans _XX à la fin et suprime les orriginaux
Sub Renomme_XX (FSO, FolderPath)
 
'Get access to the folder
	Set obFolder = FSO.GetFolder(FolderPath)
 
	'Loop on all the files and process each of them
	For Each obFile In obFolder.Files
 
		If (StrComp(Right(obFile.Name, 3), "wcl", 1) = 0) AND _
		   (InStr(1, obFile.Name, "_xx", 1)) Then
		    'Wscript.echo obFile.name 'donne le bon nom de fichier
			'Wscript.echo obFolder 'donne le bon chemin mais sans le \ à la fin
			'Wscript.Echo obfile.path 'donne le bon chemin
		'Wscript.echo (Len(obfile.path) - 7)
		'FileName = (Len(obfile.path) - 7) & Right(obfile.path, 4)
		'Wscript.echo "nom fichier = " & FileName
		'Wscript.echo obfile.Path
		FSO.CopyFile obFile.Path, Left(obFile.Path, Len(obFile.Path) - 7) & Right(obFile.Path, 4)
		'Wscript.echo "fichier à effacer : " & obfile.Path
		FSO.Deletefile(obfile.path)
 
		End If
 
	Next
 
	'Loop on all the subfolders and process each of them
	For Each obSubFolder In obFolder.SubFolders
		Renomme_XX FSO, obSubFolder.Path
	Next
 
End Sub | 
Partager