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
| Sub trifichier()
Dim Fso
Dim origin : origin ="F:\origin\"
Dim fichier : fichier = ".jpg"
Dim destin : destin = "F:\destin"
'Pour accéder aux fichiers, aux répertoires et aux volumes gérés par Windows,
Set Fso = CreateObject("Scripting.FileSystemObject")
If Fso.FolderExists(destin) = False Then Exit Sub
'Pour avoir accès aux fichiers d'un répertoire, on peut d'abord accéder à un objet Folder (pour le répertoire visé)
Set origin = Fso.GetFolder(destin)
For Each fichier In origin
If Fso.FolderExists(origin & "\" & UCase(Mid(fichier, InStrRev(fichier, ".") - 15, 3))) = True Then
Fso.MoveFile fichier, origin & "\" & UCase(Mid(fichier, InStrRev(fichier, ".") - 15, 3)) & "\" & fichier
Else
'CreateFolder: Créer un nouvel objet
'Ucase : Convertit la chaîne string en majuscules.
'Mid : Renvoie un nombre spécifié (length) de caractère à partir d'une chaîne de caractères (string).
'InStrRev : Renvoie la position de la 1ere occurence d'une chaîne de caractères (string2) dans une autre (string1), en commençant par la fin
Set destin = Fso.CreateFolder(origin & "\" & UCase(Mid(fichier, InStrRev(fichier, ".") - 15, 3)))
Fso.MoveFile fichier, destin & "\" & fichier
End If
Next
End Sub |
Partager