Excel/VBA - Move all types of files

December 2016


Excel/VBA - Move all types of files



Small application to move your files (whatever the type) from a "Source" to "Destination" directory.

Introduction


Software required for this application: Excel (all versions> 97)

References - VBE editor: "Microsoft Scripting Runtime"
This procedure uses a library of objects which by default is not included in the VBE editor. We must therefore add a reference to this library:
Open VBE: (to access it from a worksheet of your Excel workbook, press ALT + F11 simultaneously)
  • Menu: Tools
  • Choice: References
  • Select "Microsoft Scripting Runtime"



Two UserForm will be needed:
  • In VBE:
  • Menu: Insert
  • Choice: UserForm



The controls include:

In UserForm1:
- 4 command buttons, (CommandButton1, CommandButton2, CommandButton3, CommandButton4)
- 2 Labels, to host the paths (Label1, Label2)
- 5 Labels, to host the names of the column headers of the Listbox (Label3, Label4, Label5, Label6, Label7)
- 2 CheckBox (CheckBox1 (select all files), CheckBox2 (New directory))
- A ListBox (ListBox1)

In UserForm2:
- 2 command keys (CommandButton1, CommandButton2)
- 1 TextBox (TextBox1)
- Label 1 (optional)

The 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

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

Example of use


On an Excel spreadsheet, draw a command button ( View menu, toolbar: Toolkit controls).
In the module of the sheet (to access it: Right-click the sheet tab > View Code) copy and paste this code:
Private Sub CommandButton1_Click()    
'Démarrer
UserForm1.Show
End Sub

Download the sample workbook


You can download the sample workbook: here

Related :

This document entitled « Excel/VBA - Move all types of files » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.