VBA - Excel Déplacer tous types de fichiers

Petite application pour déplacer vos fichiers (quel qu'en soit le type) d'un répertoire « source » vers un répertoire « destination ».

Introduction

Logiciel requis pour cette application : Excel (toutes versions > 97)

Références - Editeur VBE : « Microsoft Scripting Runtime »
Cette procédure utilise une librairie d'objets qui, par défaut, n'est pas incluse dans l'éditeur VBE. Il faut donc ajouter une référence à cette libraire:

• Dans VBE : (pour y accéder, depuis une feuille de calcul de votre classeur Excel, tapez simultanément ALT+F11)
  • Menu : Outils
  • Choix : Références
  • Cochez : « Microsoft Scripting Runtime »

Deux UserForm sont nécessaires, profitez d'être encore sous VBE pour les créer :
Création des UserForm :

• Sous VBE :
  • Menu : Insertion
  • Choix : UserForm

Les contrôles à insérer :

Dans l'UserForm1 :
- 4 Boutons de Commande, (CommandButton1, CommandButton2, CommandButton3, CommandButton4)
- 2 Labels, en charge d'accueillir les chemins d'accès (Label1, Label2)
- 5 Labels, en charge d'accueillir les noms d'entêtes des colonnes de la Listbox (Label3, Label4, Label5, Label6, Label7)
- 2 CheckBox (CheckBox1 (sélectionner tous les fichiers), CheckBox2(Nouveau répertoire))
- 1 ListBox (ListBox1)

Dans l'UserForm2 :
- 2 Boutons de Commande, (CommandButton1, CommandButton2)
- 1 TextBox (TextBox1)
- 1 Label (facultatif)

L'UserForm1

Code de l'UserForm1

Option Explicit     

'---------------------------------------     
'Procédure de sélection de tous les fichiers dans la listbox     
Private Sub CheckBox1_Click()     
Dim i As Long     

If CheckBox1.Value = True Then     
    For i = 0 To ListBox1.ListCount - 1     
        If ListBox1.Selected(i) = False Then ListBox1.Selected(i) = True     
    Next i     
Else     
    For i = 0 To ListBox1.ListCount - 1     
        If ListBox1.Selected(i) = True Then ListBox1.Selected(i) = False     
    Next i     
End If     
End Sub     

'-------------------------------------     
'Montre l'UserForm2 afin de créer un nouveau répertoire     
Private Sub CheckBox2_Click()     

If CheckBox2.Value = True Then     
    UserForm2.Show     
End If     
End Sub     

'--------------------------------------     
'Choix du répertoire destination     
Private Sub CommandButton2_Click()     
Dim objShell As Object, objFolder As Object     

    Set objShell = CreateObject("Shell.Application")     
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)     

If objFolder Is Nothing Then     
    MsgBox "Abandon opérateur", vbCritical, "Annulation"     
Else     
    Label2.Caption = objFolder.ParentFolder.ParseName(objFolder.Title).Path     
End If     
End Sub     

'---------------------------------------     
'Déplacement des fichiers sélectionnés     
Private Sub CommandButton3_Click()     
Dim i As Long     
Dim source As String, destin As String, message As String     
Dim oFSO As Scripting.FileSystemObject     
Dim Rep As Integer     

message = "Etes-vous sur(e) de vouloir déplacer le(s) fichier(s) sélectionné(s) de : " & vbLf & vbLf & Label1.Caption & vbLf & vbLf & "vers : " & vbLf & vbLf & Label2.Caption     
Rep = MsgBox(message, vbYesNo + vbQuestion, "Confirmation")     
If Rep = vbYes Then     

    Set oFSO = New Scripting.FileSystemObject     
         
        For i = 0 To ListBox1.ListCount - 1     
            If ListBox1.Selected(i) = True Then     
                source = Label1.Caption & "\" & ListBox1.List(i)     
                destin = Label2.Caption & "\" & ListBox1.List(i)     
                If oFSO.FileExists(source) Then     
                    oFSO.MoveFile source, destin     
                End If     
            End If     
        Next i     
    ElementsRepertoire Label1.Caption     
    MsgBox "Déplacement(s) effectué(s).", vbOKOnly + vbInformation, "Fin de traitement"     
Else     
    MsgBox "Abandon opérateur", vbCritical, "Annulation"     
End If     
End Sub     

'--------------------------------------------     
'Effacement des contrôles de l'UserForm1     
Private Sub CommandButton4_Click()     
ListBox1.Clear     
Label1.Caption = ""     
Label2.Caption = ""     
CheckBox1.Value = False     
CheckBox2.Value = False     
End Sub     

'------------------------------------------     
'Initialisation de la listbox     
Private Sub UserForm_Initialize()     
With ListBox1     
    .ColumnCount = 5     
    .ColumnWidths = "170;50;60;50;200"     
    .SetFocus  'inutile, uniquement esthétique     
End With     
End Sub     

'----------------------------------------     
'Choix du répertoire source     
Private Sub CommandButton1_Click()     
Dim objShell As Object, objFolder As Object     
         
    Set objShell = CreateObject("Shell.Application")     
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)     

If objFolder Is Nothing Then     
    MsgBox "Abandon opérateur", vbCritical, "Annulation"     
    End     
Else     
    ElementsRepertoire objFolder.ParentFolder.ParseName(objFolder.Title).Path     
End If     
End Sub     

'-----------------------------------------     
'remplissage de la listbox     
Private Sub ElementsRepertoire(Chemin As String)     
Dim objShell As Object, strFileName As Object     
Dim objFolder As Object     
Dim NomFic As String, Passe As String     

    Set objShell = CreateObject("Shell.Application")     
    Set objFolder = objShell.Namespace(CStr(Chemin))     
         
Label1 = Chemin     
ListBox1.Clear     
For Each strFileName In objFolder.Items     
    If strFileName.isFolder = False Then     
        Passe = Chemin & "\" & strFileName & "*.*"     
        NomFic = Dir(Passe)     
        With ListBox1     
            .AddItem NomFic     
            .List(ListBox1.ListCount - 1, 1) = objFolder.GetDetailsOf(strFileName, 1)     
            .List(ListBox1.ListCount - 1, 2) = Format(objFolder.GetDetailsOf(strFileName, 4), "DD/MM/YYYY")     
            .List(ListBox1.ListCount - 1, 3) = Format(objFolder.GetDetailsOf(strFileName, 3), "DD/MM/YYYY")     
            .List(ListBox1.ListCount - 1, 4) = objFolder.GetDetailsOf(strFileName, 14)     
        End With     
    End If     
Next strFileName     
End Sub

L'UserForm2

Code de l'UserForm2

Option Explicit     

Dim CheminRepParent As String     

'-------------------------------------------     
'choix du répertoire parent, dans lequel sera créé notre répertoire     
Private Sub CommandButton1_Click()     
Dim objShell As Object, objFolder As Object     
         
    Set objShell = CreateObject("Shell.Application")     
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)     

If objFolder Is Nothing Then     
    MsgBox "Abandon opérateur", vbCritical, "Annulation"     
Else     
    CheminRepParent = objFolder.ParentFolder.ParseName(objFolder.Title).Path     
End If     
End Sub     

'--------------------------------------------     
'Création du répertoire     
Private Sub CommandButton2_Click()     
Dim oFSO As Scripting.FileSystemObject     
Dim oFld As Folder     
Dim CheminComplet As String     

If TextBox1 = "" Then Exit Sub     
Set oFSO = New Scripting.FileSystemObject     

CheminComplet = CheminRepParent & "\" & TextBox1     
If oFSO.FolderExists(CheminComplet) Then     
    MsgBox "Ce dossier existe déjà"     
    Exit Sub     
Else     
    On Error Resume Next     
    Set oFld = oFSO.CreateFolder(CheminComplet)     
End If     
UserForm1.Label2.Caption = CheminComplet     
UserForm1.CheckBox2.Value = False     
Unload Me     
End Sub     

'----------------------------------------------------     
'Empêcher la saisie de caractères interdits ou déconseillés     
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)     
If InStr("""!{['^]}/\*?<>|:", Chr(KeyAscii)) <> 0 Then     
    MsgBox "Caractère interdit ou déconseillé"     
    KeyAscii = 0     
End If     
End Sub     

'-----------------------------------------------     
'vidage du Textbox1     
Private Sub UserForm_Initialize()     
TextBox1 = ""     
End Sub

Exemple d'emploi

Sur une feuille Excel, dessinez un bouton de commande (dans le menu affichage, barre d'outils : Boîte à outils contrôles).
Dans le module de la feuille (pour y accéder : clic droit sur l'onglet de la feuille concernée/Visualiser le code) copiez-collez ce code :

Private Sub CommandButton1_Click()       
    'Démarrer       
    UserForm1.Show       
End Sub

Téléchargement

Vous pouvez télécharger Le classeur exemple
Si toutefois celui-ci n'est plus disponible sur cjoint, merci de me le faire savoir en m'envoyant un MP ici, cliquez sur « Lui écrire un message »