Déplacer des fichiers texte vers un répertoire [Résolu]

Signaler
Messages postés
26
Date d'inscription
lundi 3 juillet 2006
Statut
Membre
Dernière intervention
5 mars 2009
-
Messages postés
26
Date d'inscription
lundi 3 juillet 2006
Statut
Membre
Dernière intervention
5 mars 2009
-
Salut, je desire faire un déplacement de 2 fichiers d'un repertoire a un autre, j'ai utilise le code ci-dessous, mais lorsque j'execute le code, un seul des fichiers est deplace, puis j'obtiens un message d'erreur "File Not Found". Je desire deplacer les 2 fichiers en meme temps vers leurs repertoires correspondants. Que dois-je corriger dans le code? Merci pour votre reponse.

Private Sub Form_Load()

Dim folder, file, filelist()

i = 0
ReDim filelist(0)

Set folder = fso.GetFolder("\\repertoire\sous_repertoire")

For Each file In folder.Files

If LCase(Right(file.Name, 3)) = "txt" Then
i = i + 1
ReDim Preserve filelist(i)
Set filelist(i) = file

For j = 0 To i
fname = Mid(file.Name, 1, 3)
Select Case fname
Case "Act"
fso.MoveFile "\\repertoire\sous_repertoire" & file.Name, "\\repertoire\sous_repertoire\Activations" & file.Name
Case "Aut"
fso.MoveFile "\\repertoire\sous_repertoire" & file.Name, "\\repertoire\sous_repertoire\Authorizations" & file.Name
End Select

Next
End If
Next

1 réponse

Messages postés
26
Date d'inscription
lundi 3 juillet 2006
Statut
Membre
Dernière intervention
5 mars 2009

Bon, pour ceux qui seraient interesses, j'ai trouve la reponse. Merci qd meme...

Dim folder, file, filelist()

i = 0
ReDim filelist(0)

Set folder = fso.GetFolder("\\repertoire\sous-repertoire")

For Each file In folder.Files

If LCase(Right(file.Name, 3)) = "txt" Then
i = i + 1
ReDim Preserve filelist(i)
Set filelist(i) = file
End If
Next

For j = 1 To i
fname = Mid(filelist(j).Name, 1, 3)
Select Case fname
Case "Act"
fso.MoveFile "\\repertoire\sous-repertoire" & filelist(j).Name, "\\repertoire\sous-repertoire\Activations"
Case "Aut"
fso.MoveFile "\\repertoire\sous-repertoire" & filelist(j).Name, "\\repertoire\sous-repertoire\\Authorizations"
End Select
Next