Comment déplacer un fichier en le renommant avec incrémentation si le fichier existe ?

Version imprimable

:salut:
Afin d'améliorer mon Vbscript Hackoo VIRUS Cleaner.vbs
J'ai créé ce code pour le tester avant de le mettre en œuvre dans mon script principal, mais, je reçois quelques problèmes à la ligne N ° 46 avec erreur "fichier n'existe pas"

Code:

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
Option Explicit
Dim SFile,SFile1,SFile2,SFile3,SFile4,Folder,Title,Rename
Title = "Moving File to the Quarantaine Folder ..."
SFile = "E:\HackooTest\Nouveau dossier\VIRUS.vbs"
Folder = "E:\HackooTest\Quarantaine"
Rename = GetNameFile(sFile)
Call MoveFile2Quarantaine(sFile,Folder,Rename)
MsgBox "The File " & DblQuote(Rename) & " is moved to the Quarantaine Folder",VbInformation,Title
'*************************************************************************************
SFile1 = "E:\HackooTest\Nouveau dossier(2)\VIRUS.vbs"
Rename = GetNameFile(sFile1)
Call MoveFile2Quarantaine(sFile1,Folder,Rename)
MsgBox "The File " & DblQuote(Rename) & " is moved to the Quarantaine Folder",VbInformation,Title
'*************************************************************************************
SFile2 = "E:\HackooTest\Nouveau dossier(3)\VIRUS.vbs"
Rename = GetNameFile(sFile2)
Call MoveFile2Quarantaine(sFile2,Folder,Rename)
MsgBox "The File " & DblQuote(Rename) & " is moved to the Quarantaine Folder",VbInformation,Title
'*************************************************************************************
SFile3 = "E:\HackooTest\Nouveau dossier(4)\VIRUS.vbs"
Rename = GetNameFile(sFile3)
Call MoveFile2Quarantaine(sFile3,Folder,Rename)
MsgBox "The File " & DblQuote(Rename) & " is moved to the Quarantaine Folder",VbInformation,Title
'*************************************************************************************
SFile4 = "E:\HackooTest\Nouveau dossier(5)\VIRUS.vbs"
Rename = GetNameFile(sFile4)
Call MoveFile2Quarantaine(sFile4,Folder,Rename)
MsgBox "The File " & DblQuote(Rename) & " is moved to the Quarantaine Folder",VbInformation,Title
'*************************************************************************************
Sub MoveFile2Quarantaine(sFile,Folder,Rename)
	'On Error Resume Next
	Dim  FSO,Ws,Tab,i,j
	Set Ws = CreateObject("Wscript.Shell")
	Set FSO = CreateObject("Scripting.FileSystemObject")
	'Tab = Split(sFile,"\")
	'Rename = Tab(UBound(Tab))
	i = 0
	j = i + 1
	Do
		i = i + 1
		'If FSO.FolderExists(Folder) Then
			If Not FSO.FileExists(Folder & "\" & Rename & "_Infected.txt") Then
				FSO.GetFile(sFile).Move Folder & "\" & Rename & "_Infected.txt"
				Exit Sub
			ElseIf Not FSO.FileExists(Folder & "\" & Rename & "("& i &")" & "_Infected.txt") Then 'And FSO.FileExists(Folder & "\" & Rename & "_Infected.txt") Then
				FSO.GetFile(sFile).Move Folder & "\" & Rename & "("& j &")" & "_Infected.txt"
				Exit Sub
			ElseIf j = i Then
				j = j + 1
				If Not FSO.FileExists(Folder & "\" & Rename & "("& j &")" & "_Infected.txt") Then
					FSO.GetFile(sFile).Move Folder & "\" & Rename & "("& j &")" & "_Infected.txt"
					Exit Sub
				End if
			End If
		'End If
	Loop Until j = i
End Sub
'**********************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
	DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Function GetNameFile(sFile)
	Dim  Tab
	Tab = Split(sFile,"\")
	GetNameFile = Tab(UBound(Tab))
End Function

:merci: de votre aide ;)

Bonjour,

Voici un petit bout de code pour enregistrer un fichier avec incrémentation si le fichier existe déjà (à adapter) :
Code:

1 2 3 4 5 6 7 8 Save_Path = FolderPath & FileName & Ext n = 1 Same_Path = Save_Path Do While Dir(Save_Path) <> "" Save_Path = Left(Same_Path, Len(Same_Path) - Len(Ext)) & " (" & n & ")" & Ext n = n + 1 Loop
Vu le type d'erreur, cependant, je dirais que le problème vient de la fonction .Move : il semble ne pas trouver pas le fichier source.

Tu peux essayer plutôt avec :

Code:

FSO.MoveFile SourceFile, DestinationFile

Bonne journée.

Citation:

Envoyé par SCryptCypher

Code:

1
2
3
4
5
6
7
Save_Path = FolderPath & FileName & Ext
n = 1
Same_Path = Save_Path
Do While Dir(Save_Path) <> ""
   Save_Path = Left(Same_Path, Len(Same_Path) - Len(Ext)) & " (" & n & ")" & Ext
   n = n + 1
Loop

Vu le type d'erreur, cependant, je dirais que le problème vient de la fonction .Move : il semble ne pas trouver pas le fichier source.
Tu peux essayer plutôt avec :

Code:

FSO.MoveFile SourceFile, DestinationFile

:salut: et :merci: pour votre remarque car j'ai pu m'en sortir avec cette dernière :plusser: :king:
et voici le code qui fonctionne correctement :king: et le problème est :resolu: :mouarf:

Code:

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
Option Explicit
Dim fso,Ws,sFiles,sFile,sFileName,Quarantaine,Title
Title = "Déplacement des fichiers suspects dans la quarantaine" 
Set fso = CreateObject("Scripting.FileSystemObject")
Set Ws = CreateObject("wscript.Shell")
Quarantaine = "e:\HackooTest\Quarantaine"
sFiles = Array( _
"e:\HackooTest\Folder1\VIRUS.vbs", _
"e:\HackooTest\Folder2\VIRUS.vbs", _
"e:\HackooTest\Folder3\VIRUS.vbs", _
"e:\HackooTest\Folder4\VIRUS.vbs", _
"E:\HackooTest\Folder5\VIRUS.vbs", _
"E:\HackooTest\Folder6\VIRUS.vbs" _
)
 
For Each sFile In sFiles
    If fso.FileExists(sFile) Then
        sFileName = GetNewName(sFile)
        fso.MoveFile sFile,sFileName 
        Ws.Popup "Le fichier " & DblQuote(sfile) & " est déplacé vers le dossier quarantaine comme " & DblQuote(sFileName),"4",Title,VbInformation
    Else
        Ws.Popup DblQuote(sfile) & " n'existe pas !","2",Title,VbExclamation
    End If
Next
'**********************************************************************************************
Function GetNewName(sFile)
    Dim snamebase,sname,i,sTarget
    snamebase = Split(Right(sFile, Len(sFile) - InStrRev(sFile,"\")),".")(0)
    sname = snamebase
    i = 0
    While i < 100
        sTarget = Quarantaine & "\" & sname & "_Infected.txt"
        If fso.FileExists(sTarget) Then
            i = i + 1
            sName = snamebase & "(" & i & ")"
        Else
            GetNewName = sTarget
            Exit Function
        End If
    Wend
End Function
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************