VBA - Excel Déplacer tous types de fichiers

Dernière mise à jour le par pijaku .


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 »

Cet article est régulièrement mis à jour par des experts sous la
direction de Jean-François Pillou, fondateur de CommentCaMarche.
A voir également
Ce document intitulé « VBA - Excel Déplacer tous types de fichiers » issu de Comment Ça Marche (www.commentcamarche.net) est mis à disposition sous les termes de la licence Creative Commons. Vous pouvez copier, modifier des copies de cette page, dans les conditions fixées par la licence, tant que cette note apparaît clairement.