Discussion :

[anto9191]

Bonjour, je suis totalement novice en vbs.

Ma problématique:
J'ai 700 fichiers dans un dossier 1, et j'aurai besoin de les ranger dans 700 dossiers contenus dans un autre dossier 2. Chaque fichier portant le même nom que son dossier cible respectif + une extension : "nomdudossier_xx_xXX.raw" à ranger dans "nomdudossier\

individuellement je peut le faire avec ce code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
fso.CopyFile "Z:\dossierparent1\nomdudossier_XX_XXX.raw", "Z:\dossierparent2\nomdudossier"

Je souhaiterai créer une boucle me permettant de gérer les 700 fichiers et les transférer dans leur dossier respectif.

Merci d'avance pour votre aide.

AA

[l_autodidacte]

Bonjour et BIENVENU sur DVP

S'il s'agit d'une simple copie, la méthode Copy ou CopyFile peut faire l'affaire
S'il s'agit de déplacer les fichiers, on utilisera la méthode Move ou MoveFile
Dans un cas comme dans l'autre, le dossier destination du fichier en cours devrait être créé au préalable.
Selon le choix, dé-commente la ligne 12 ou 13 mais pas les 2 en même temps :

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
Option Explicit 
 
Dim fso, Dossier1, Dossier2, oFold, Fichier, tmpPath 
 
Dossier1 = "C:\TestDir\Temp"     ' A remplace par le dossier source
Dossier2 = "C:\TestDir\Tmp"      ' A remplace par le dossier destination
Set fso = CreateObject("Scripting.FileSystemObject") 
 
Set oFold = fso.GetFolder(Dossier1)
For Each Fichier In oFold.Files
    tmpPath = CreateDir(Fichier.Path)
    'Fichier.Copy tmpPath , True
    'Fichier.Move tmpPath
Next
'======================
Function CreateDir(sFileName)
  Dim Ret
      Dossier2 = AddDirSep(Dossier2)  ' On s'assure que le chemin se termine par \
      Ret = fso.GetBaseName(sFileName) 
      If Not fso.FolderExists(Dossier2 & Ret) Then 
         CreateDir = AddDirSep(fso.CreateFolder(Dossier2 & Ret))
      Else
        CreateDir = AddDirSep(Dossier2 & Ret)
      End If
End Function
'========================
Function AddDirSep(sDir)
  If Right(sDir, 1) <> "\" Then 
     AddDirSep = sDir & "\"
  Else 
     AddDirSep = sDir
  End If
End Function