Menu
Merci
0
Merci

Quelques mots de remerciements seront grandement appréciés.

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 »
Merci
0
Merci

Quelques mots de remerciements seront grandement appréciés.

Cet article est régulièrement mis à jour par des experts sous la
direction de Jean-François Pillou, fondateur de CommentCaMarche
et directeur délégué au développement numérique du groupe Figaro.

A voir également

Publié par . Dernière mise à jour le par pijaku.

Ce document intitulé «  VBA - Excel Déplacer tous types de fichiers  » issu de CommentCaMarche (https://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.

0 Commentaire