Discussion :

[YLKweb]

Bonjour à tous !

J'ai un petit soucis de création de VBS qui ne paraitra que broutille pour la plupart d'entre vous...

J'ai le besoin de déplacer des fichiers et dossiers automatiquement d'un dossier à un autre.
Précision, les noms des fichiers et dossiers déposé dans le répertoire source ne sont pas connus (il s'agit d'un FTP).

Bien entendu, si le fichier ou dossier existe déjà dans la destination, le besoin est de le renommer en incrémentant un numéro de type "_01", "_02", etc...
Je ne suis pas très doué en VBS mais je bidouille un peu et en glanant de ci de là des morceaux de scripts, j'ai réussi à obtenir à peu près ce que je voulais.
La seule chose qui me manque aujourd'hui est l'incrément pour les dossiers !

Cela fonctionne pour les fichiers mais je n'y parviens pas pour les dossiers...
Résultat, les dossiers déposé dans la source et qui existent déjà dans la destination sont déplacé mais écrasent les existants...

Je suppose que ce n'est pas sorcier mais je ne trouve pas le moyen de le faire marcher.

Pourrais-t-on m'aider svp ?

Par ailleurs, si vous trouvez moyen, de votre oeil d'expert, de simplifier ce script constitué surement inutilement de plusieurs sections (traitement fichiers, puis dossiers, etc...), je suis preneur.

Merci d'avance à qui voudra bien m'aider.

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
Const cnMax = 99
 
  Dim goFS    : Set goFS    = CreateObject("Scripting.FileSystemObject")
 
  Dim oSrcDir : Set oSrcDir = goFS.GetFolder("\\SERVEUR\Dossier\Source")
  Dim sDstDir : sDstDir     = "\\SERVEUR\Dossier\Destination"
  Dim oFile, nInc, sNFSpec
  For Each oFile In oSrcDir.Files
      nInc    = 0
      sNFSpec = getNewFSpec(oFile.Name, sDstDir, nInc)
      Do While goFS.FileExists(sNFSpec) And nInc <= cnMax
         sNFSpec = getNewFSpec(oFile.Name, sDstDir, nInc)
      Loop
      If nInc > cnMax Then
 
      Else
 
         oFile.Move sNFSpec
      End If
  Next
 
  Set FSO = CreateObject("scripting.FileSystemObject")
 
    For Each item In oSrcDir.SubFolders
		FSO.CopyFolder oSrcDir, sDstDir, True
		FSO.DeleteFolder "\\SERVEUR\Dossier\Source\*", True
  Next
 
Function getNewFSpec(ByVal sFName, sDstDir, ByRef nInc)
  If 0 < nInc Then
     Dim sSfx
     sSfx = goFS.GetExtensionName(sFName)
     If "" <> sSfx Then sSfx = "." & sSfx
     sSfx = "_" & Right("00" & nInc, 2) & sSfx
     sFName = goFS.GetBaseName(sFName) & sSfx
  End If
  nInc        = nInc + 1
  getNewFSpec = goFS.BuildPath(sDstDir, sFName)
End Function

[YLKweb]

Personne n'a la moindre petite idée svp ?

[ericlm128]

Voici comment j'aurai fait.

Code vbs :

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
src = "\\SERVEUR\Dossier\Source"
dst = "\\SERVEUR\Dossier\Destination"
 
set fso = CreateObject("Scripting.FileSystemObject")
set oDst = fso.GetFolder(src)
 
For Each oFile In oDst.Files
	newFileName = GetNewFileName(oFile.Name, dst)
	oFile.Move(dst & "\" & newFileName)
Next
 
For Each oFolder In oDst.SubFolders
	newFolderName = GetNewFolderName(oFolder.Name, dst)
	oFolder.Move(dst & "\" & newFolderName)
Next
wscript.quit
 
' Trouve un nom de fichier dans le dossier folder
Function GetNewFileName(originalName, folder)
	base = fso.GetBaseName(originalName)
	extension = fso.GetExtensionName(originalName)
	If (extension <> "") Then extension = "." + extension
	newName = fso.GetFileName(originalName)
 
	cnt = 1
	While (fso.FileExists(folder & "\" & newName) Or fso.FolderExists(folder & "\" & newName))
		cnt = cnt + 1
		newName = base & " (" & cnt & ")" & extension
	Wend
 
	GetNewFileName = newName
End Function
 
' Trouve un nom de dossier dans le dossier folder
Function GetNewFolderName(originalName, folder)
	originalName = fso.GetFileName(originalName)
	newName = originalName
 
	cnt = 1
	While (fso.FileExists(folder & "\" & newName) Or fso.FolderExists(folder & "\" & newName))
		cnt = cnt + 1
		newName = originalName & " (" & cnt & ")"
	Wend
 
	GetNewFolderName = newName
End Function

PS : L'incrémentation de nom de fichier retenue est celle de Windows 7.

[YLKweb]

Salut !

Merci mille fois pour ce script bien plus propre que le mien !

Problème, la partie sur le déplacement des dossiers ne fonctionne pas : "Permission refusée".
En fait, il s'agit du déplacement de dossiers d'un serveur A à un serveur B...
Après quelques recherches, visiblement, ce type de déplacement n'est pas autorisé entre différents serveurs.

J'ai vainement tenté de mapper des lecteurs réseaux pour déplacer les dossiers via des chemins d'accès locaux plutôt qu'UNC, toujours rien...

En fait, visiblement la seule option est un Copy/Delete du dossier...
Du coup, un check pour voir si un dossier du même nom existe dans la destination, puis, si tel est le cas, un renommage du dossier avec un incrément avant de le Copy/Delete...

J'ai retouché ton script pour obtenir ça, pour ceux que ça intéresse :

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
On Error Resume Next
 
src = "\\SERVEUR_A\Dossier\Source"
dst = "\\SERVEUR_B\Dossier\Destination"
 
set fso = CreateObject("Scripting.FileSystemObject")
set oDst = fso.GetFolder(src)
 
For Each oFile In oDst.Files
	newFileName = GetNewFileName(oFile.Name, dst)
	oFile.Move(dst & "\" & newFileName)
Next
 
For Each oFolder In oDst.SubFolders
	newFolderName = GetNewFolderName(oFolder.Name, dst)
	If fso.FolderExists (dst & "\" & oFolder.Name) Then
		Set oNet = CreateObject("WScript.Network")
		oNet.MapNetworkDrive "S:", src
		oNet.MapNetworkDrive "T:", dst
		fso.MoveFolder ("S:\" & oFolder.Name), ("S:\" & newFolderName)
		fso.CopyFolder src, dst, True
		fso.DeleteFolder (src & "\*"), True
		oNet.RemoveNetworkDrive "S:", True
		oNet.RemoveNetworkDrive "T:", True
	Else
		fso.CopyFolder src, dst, True
		fso.DeleteFolder (src & "\*"), True
	End If
Next
wscript.quit
 
' Trouve un nom de fichier dans le dossier folder
Function GetNewFileName(originalName, folder)
	base = fso.GetBaseName(originalName)
	extension = fso.GetExtensionName(originalName)
	If (extension <> "") Then extension = "." + extension
	newName = fso.GetFileName(originalName)
 
	cnt = 1
	While (fso.FileExists(folder & "\" & newName) Or fso.FolderExists(folder & "\" & newName))
		cnt = cnt + 1
		newName = base & " (" & cnt & ")" & extension
	Wend
 
	GetNewFileName = newName
End Function
 
' Trouve un nom de dossier dans le dossier folder
Function GetNewFolderName(originalName, folder)
	originalName = fso.GetFileName(originalName)
	newName = originalName
 
	cnt = 1
	While (fso.FileExists(folder & "\" & newName) Or fso.FolderExists(folder & "\" & newName))
		cnt = cnt + 1
		newName = originalName & " (" & cnt & ")"
	Wend
 
	GetNewFolderName = newName
End Function

Ça doit pouvoir être perfectible, mais ça marche !

Merci beaucoup ericlm128, tu as bien fait avancer mon problème pour permettre de le résoudre complètement !

Résolu, encore merci !