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