VBA - Trucs et astuces

Gestion des fichiers, dossiers et lecteurs

Ce didacticiel de traitement des fichiers et dossiers peut s'appliquer à n'importe quel programme Office.

Nous allons voir comment copier, déplacer, renommer des fichiers et des dossiers, grâce à FileSystemObjects, mais également sans lui.

Nous verrons comment accéder à des dossiers spcéiaux comme le bureau ou mes documents, et comment envoyer des fichiers à la corbeille grâces aux API.

Nous étudierons les boîtes de dialogue de choix de fichiers et de dossier.

Nous verrons comment créer, et accéder à un fichier texte en lecture, écriture, ajout, et même recherche de texte.

Nous utiliserons un module de classe personnalisé pour analyser toute la structure arborescente d'un dossier, dans un but de rechercjhe et de listage de fichiers et de dossiers.

Nous accéderons à certains attributs de fichiers et de dossiers, comme la visibilité ou l'accès en lecture seule.

Nous verrons comment accéder à vos différents lecteurs de diques, qu'ils soient réseau, clé USB, ou même DVD.

Nous terminerons par un grand exercice récapitulatif de toutes les notions abordées dans ce didacticiel.

 
Sommaire
  1. Introduction
  2. Mise en place
  3. Explication de Scripting.FileSystemObjects
  4. Création d'un dossier et de fichiers de test
  5. CreateObject et Auto-Complétion
  6. Gestion globale des fichiers
  7. Copie de fichiers (.CopyFile ou FileCopy)
  8. Déplacement de fichiers (.MoveFile)
  9. Renommage de fichiers (.MoveFile également)
  10. Effacement de fichiers (.DeleteFile ou Kill)
  11. Corbeille (DLL shell32.dll)
  12. Parcourt de tous les fichiers d'un dossier (Dir)
  13. Gestion des dossiers
  14. Création d'un dossier (.CreateFolder ou MkDir)
  15. Suppression d'un dossier (.DeleteFolder ou RmDir)
  16. Copie de tout le contenu d'un dossier (.CopyFolder)
  17. Déplacement du contenu d'un dossier (.MoveFolder)
  18. Test de l'existence d'un dossier (.FolderExists)
  19. Traitement global des dossiers (.GetFolder, .dateCreated, .DateLastAccessed)
  20. Taille totale des fichiers contenus dans un dossier (.Size)
  21. Nombre de fichiers dans un dossier (.Files.Count)
  22. Nombre de sous-dossiers dans un dossier (.SubFolders.Count)
  23. Parcourt des sous-dossiers directs d'un dossier (Each, SubFolders)
  24. Accès aux dossiers spéciaux (.GetSpecialFolder ou API shell32.dll)
  25. Attributs et détails des fichiers et dossiers (.Attributes ou SetAttr Hidden, ReadOnly, System)
  26. Autres détails d'un fichier (Extension, Lecteur. nom)
  27. Taille des fichiers (FileLen ou .Size)
  28. Parents
  29. Dossier parent (.ParentFolder)
  30. Dossier grand-parent
  31. Lecteur parent (.Drive ou GetDriveName)
  32. Lecteurs
  33. Propriétés des lecteurs (.SerialNumber, DriveExists)
  34. Espace libre et occupé des lecteurs (.TotalSize, Conversion Ko, Mo, Go, To, Format, .FreeSpace)
  35. Listing des lecteurs disponibles (.Drives.Count, For Each et .Drive, .IsReady, .DriveLetter)
  36. Types de lecteurs (Disque dur, CD-ROM, etc., .DriveType)
  37. Fichiers texte : Création, lecture, modification
  38. Création d'un fichier texte et écriture d'une ligne dedans (.TextStream, .CreateTextFile, .WriteLine, .Close)
  39. Test de l'existence d'un fichier (.FileExists)
  40. Ecriture dans un fichier déjà existant (.OpenTextFile, ForAppending, WriteLine Vs. Write)
  41. Lancement automatique du bloc-notes (Shell, Notepad.exe)
  42. Exécution de n'importe quel type de fichier
  43. Lecture du contenu d'un fichier texte (ForReading, .ReadLine, .AtEndOfStream, Read(X), ReadAll)
  44. Modification d'un fichier : complications obligatoires (Transfert dans un tableau)
  45. Gestion de fichiers texte : ancienne méthode (Open, For Input/Output/Append, #1, Close, EOF
  46. Boîtes de dialogues intégrées de choix de fichiers/Dossiers (Application.FileDialog, msoFileDialogFilePicker, .Show)$
  47. Affichage du fichier choisi (.SelectedItems(1))
  48. Gestion du bouton "Annuler" (If, .Show = True)
  49. Titre de la boîte de dialogue (.Title)
  50. Personnalisatuion du bouton "Ouvrir" (.ButtonName)
  51. Boîte de dialogue garde les paramètres en mémoire
  52. Raccourcissement de la syntaxe (With, End With)
  53. Emplacement initial/Fichier par défaut (.InitialFileName)
  54. Filtres de fichiers (.Clear, .Add, .FilterIndex, et encore .InitialFileName)
  55. Sélection de plusieurs fichiers (.AllowMultiSelect, .SelectedItems(X) et For To Next)
  56. Subtilités des différentes boîtes de dialogue (msoFileDialog|FilePicker|Open|FolderPicker|SaveAs)
  57. Sélection d'un dossier (msoFileDialogFolderPicker)
  58. Exemple complet de toutes les options d'une boîte de dialogue
  59. Recherche de fichiers/Dossiers (.FileSearch)
  60. Création d'un module de classe
  61. Arborescence d'exemple
  62. Nombre total de fichiers et de dossiers (ListeDossier.Count, ListeFichier.Count)
  63. Affichage de tous les dossiers et fichiers (Utilisation de notre classe personnalsée)
  64. Recherche d'un type de fichier
  65. Effacement de tous les fichiers d'un certain type
  66. Affichage/Suppression de tous les dossiers vides
  67. Exercice complet (Solution complète ici)

Introduction

Mise en place

Dans ce didacticiel, je vais utiliser Excel 2010.

  1. Lancez Excel 2010
  2. Enregistrez ce classeur vide sous SystemeFichier.xlsm (et pas xlsx)
  3. Allez dans VBA avec le raccourci-clavier Alt-F11
  4. Créez un nouveau Module

Allez dans VBA de n'importe quel programme, et créez un nouveau module :

Créez une nouvelle Macro Fichier1 :

Explication de Scripting.FileSystemObject

Tous les exemples qui suivent vont être basés sur l'objet Scripting.FileSystemObject.

Essayez :

Sub Fichier1()
    Set Banane = CreateObject("Scripting.FileSystemObject")
End Sub

Exécutez ce code en appuyant sur la touche F5 de votre clavier. Il ne se passe rien, c'est normal. Mais il ne donne pas d'erreur, c'est ce qui est important !

Banane est une variable que je viens d'inventer. Remplaçons-là par un nom plus parlant : GestionFichier.

Ensuite, déclarons-là, même si ce n'est pas obligatoire

Enfin, libérons-là. Ces deux étapes ne sont pas indispensables, mais ça rend le code plus compréhensible, et permet d'éviter certaines erreurs.

Sub Fichier1()
    Dim GestionFichier As Object
    Set GestionFichier = CreateObject("Scripting.FileSystemObject")
    Set GestionFichier = Nothing
End Sub

Création d'un dossier et fichiers de test

Afin de pouvoir faire quelques tests, nous avons besoin d'un dossier de test, dans lequel nous créerons quelques fichiers.

 

 

Dans mon cas, je dispose d''un lecteur F, dans lequel j'ai un dossier Atelier, dans lequel je peux créer quelques fichiers. Je vous propose de lance Word, et de créer un fichier qui contient juste le texte "Bonjour", et que vous appelerez Test.docx dans votre dossier de test:

CreateObject et auto-complétion

Nous allons commencer par faire une copie de ce fichier. La syntaxe est simple : recopiez ceci :

Sub Fichier1()
    Dim GestionFichier As Object
    Set GestionFichier = CreateObject("Scripting.FileSystemObject")
    GestionFichier.CopyFile "F:\Atelier\Test.docx", "F:\Atelier\Test2.docx"
    Set GestionFichier = Nothing
End Sub

Lancez la macro avec F5 : rien ne se passe à l'écran, mais si vous allez dans l'explorateur, dans votre dossier de test, vous constaterez qu'il y a bien maintenant, une copie de votre fichier :

Ca fonctionne donc très bien.

Par contre, quelque chose me chagrine : l'auto-complétion n'est pas activée ! L'auto-complétion, c'est une fonction bien pratique de VBA qui permet de connaître les propriétés et les méthodes des objets.

Je m'explique : Actuellement, si vous écrivez :

GestionFichier - A l'instant ou vous écrivez le point - GestionFichier. : il ne vous propose pas CopyFile ! Si l'auto-complétion était active, à l'instant ou vous écrivez le point ., une liste de choix s'affiche, comme ceci :

 

 

Afin de jouir de cette fonctionnalité, il vous faut intégrer la Bibliothèque Microsoft Scripting RunTime. Pour ce faire, il vous faut aller dans le menu Outils/Références, et cocher la case Microsoft Scripting RunTime.

Gestion globale des fichiers

Copie de fichier

Maintenant, la syntaxe est quelque peu différente : Essayez ceci :

Sub Fichier1()
    Dim GestionFichier As Object
    Set GestionFichier = CreateObject("Scripting.FileSystemObject")
    GestionFichier.CopyFile "F:\Atelier\Test.docx", "F:\Atelier\Test2.docx"
    Set GestionFichier = Nothing
End Sub
Sub CopieFichier()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' L'auto-complétion est activée dès que vous écrivez le point .
    GestionFichier.CopyFile "F:\Atelier\Test.docx", "F:\Atelier\Test3.docx"
    Set GestionFichier = Nothing
End Sub

Si Test3.docx existait déjà, il serait purement et simplement écrasé par la copie ! Si vous désirez que, dans le cas ou le fichier de destination existe déjà, il vous affiche un message d'erreur au lieu d'écraser le fichier, il faut alors écrire :

GestionFichier.CopyFile "F:\Atelier\Test.docx",
"F:\Atelier\Test3.docx", False

 

Testez Fichier2 : vous obtiendrez donc la copie de Test.docx en Test3.docx, mais cette fois, l'auto-complétion est activée !

Méthode alternative, plus simpliste

Voici une autre méthode pour copier des fichiers, ne nécessitant pas FileSystemObject : (Ce n'est plus CopyFile, mais FileCopy :

Sub CopieAlternative()
    FileCopy "F:\Atelier\Test.docx", "F:\Atelier\Test3.docx"
End Sub

Cette méthode est plus brutale : on n'a pas le 2ème paramètre qui permet de stopper le processus en cas de fichier Test3.docx existant : le fichier sera écrasé, point-barre ! Par contre, si le fichier-cible est ouvert, nous auront aussi un message d'erreur.

Le Bloc-Notes (NotePad) fonctionne un peu particulièrement, par rapport aux autres programmes comme Word ou Excel. En effet, si vous essayez d'effacer un fichier actuellement ouvert dans Word ou Excel, vous aurez bien normalement un  message d'erreur. Par contre, un fichier actuellement ouvert avec le bloc-notes peut sans problème s'effacer, ou se renommer... Aussi, soyez attentif à cette particularité lors de vos tests d'effacement-renommage avec VBA.

Déplacement de fichiers

Admettons que vous ayez un fichier Test.docx dans F:\Atelier que vous aimeriez déplacer dans le dossier déjà existant DossierTestScript, vous devez spécifier le fichier à déplacer, mais aussi le nom du fichier "récepteur". Je m'explique :

Sub DeplaceFichier()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' Cette ligne ne marche pas :
    GestionFichier.MoveFile "F:\Atelier\Test.docx", "F:\Atelier\TestScript"
    ' Celle-ci fonctionne :
    GestionFichier.MoveFile "F:\Atelier\Test.docx", "F:\Atelier\TestScript\Test.docx"
    Set GestionFichier = Nothing
End Sub

Il n'est pas possible, contrairement à la copie, de déplacer plusieurs fichiers à la fois en utilisant le joker * :

' Ne fonctionne pas :
GestionFichier.MoveFile "F:\Atelier\*.docx", "F:\Atelier\TestScript\*.docx"

On pourra bien entendu utiliser une boucle pour parcourir les fichiers, mais c'est un autre sujet que nous verrons plus tard.

Renommage de fichiers

Il n'existe pas de méthode Rename. On utilise également MoveFile, mais on reste dans le même dossier, simplement. Voici comment renommer Test.Docx en Tagada.xlsx (Ce serait aberrant de préciser qu'un fichier .docx devienne xlsx, mais VBA ne vous fera aucune remarque si vous le faites quand-même :

GestionFichier.MoveFile "F:\Atelier\Test.docx", "F:\Atelier\Tagada.xlsx"

Ainsi, il est possible, d'une seule opération, de déplacer un fichier et de lui donner un nouveau nom dans le nouvel emplacement :

GestionFichier.MoveFile "F:\Atelier\Test.docx", "F:\Atelier\TestScript\Tagada.xlsx"

Effacement de fichiers

L'instruction Kill arrive au même résultat, sans besoin de FileSystemObject :

Kill "F:\Atelier\Test.docx"

Sub EffaceFichier()
    Dim GestionFichier As New Scripting.FileSystemObject
    GestionFichier.DeleteFile "F:\Atelier\Test.docx"
    Set GestionFichier = Nothing
End Sub

cette commande est dangereuse ! Aucun message de confirmation ne vous est affiché, et, de plus, le fichier est définitivement effacé, sans passer par la corbeille.

Rien ne vous empêche, évidemment, de faire précéder l'instruction par une demande de confirmation :

Confirme = MsgBox("Confirmez-vous la suppression ?", vbYesNo)
If Confirme = vbYes Then
   GestionFichier.DeleteFile "F:\Atelier\Test.docx", True
End If

Si le fichier que vous tentez d'effacer est ouvert (par Word par exemple), vous aurez un message d'erreur :

Si vous ne désirez pas afficher ce message d'erreur, mais que vous désirez que le programme continue comme si de rien n'était (sans effacer le fichier, donc, vous pouvez supprimer le message d'erreur de cette manière :

Sub EffaceFichierSansErreur()
    Dim GestionFichier As New Scripting.FileSystemObject
    MsgBox "Nous sommes avant l'effacement du fichier"
    On Error Resume Next
    GestionFichier.DeleteFile "F:\Atelier\Test.docx", True
    On Error GoTo 0
    MsgBox "Nous sommes après l'effacement ou non du fichier"
    Set GestionFichier = Nothing
End Sub

Le On Error Resume Next veut dire : en cas d'erreur, tu passes à la ligne suivante sans rien dire. On Error GoTo 0 veut dire : à partir de maintenant, s'il y a d'autres erreurs, tu t'arrêtes quand même de nouveau, on ne sait jamais !

Ce qui veut dire que si le fichier est en cours d'utilisation, ou que si, simplement, il n'existe pas, dans les deux cas, il passe par dessus sans rien dire... Du coup, c'est pratique, mais ça peut être dangereux ! 

Vous pouvez tester : une fois avec un nom de fichier fantaisiste, ou en ayant ouvert le fichier : il n'y aura que les deux messages Avant et Après, mais pas d'erreur sur la ligne d'effacement. Et si vous re-testez avec le nom de fichier correct et non-ouvert, il y aura aussi les deux messages Avant et Après, mais le fichier sera effacé.

Il est possible de traiter la chose différemment selon que le fichier n'existe pas, ou qu'il soit en cours d'utilisation, c'est la gestion des erreurs plus poussée, mais ça sort largement du sujet de ce didacticiel !

Vous pouvez utiliser effacer plusieurs fichiers à la fois grâce à l'étoile : La ligne suivante efface tous les fichiers qui commencent par z, mais donc l'extension est docx :

GestionFichier.DeleteFile "F:\Atelier\z*.docx", True

Corbeille

Si vous désirez mettre le fichier dans la corbeille plutôt que de l'effacer purement et simplement, c'est nettement plus compliqué : il faut passer par les DLL. Je ne vais pas entrer dands les détails, mais il vous suffit de recopier ce code dans un nouveau module VBA :

Declare Function SHFileOperation Lib "shell32.dll" Alias _
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Type SHFILEOPSTRUCT
     hwnd As Long
     wFunc As Long
     pFrom As String
     pTo As String
     fFlags As Integer
     fAnyOperationsAborted As Boolean
     hNameMappings As Long
     lpszProgressTitle As String
End Type

Sub Corbeille(FichierAMettreDansLaCorbeille)
    Dim FileOperation As SHFILEOPSTRUCT
    Dim lReturn As Long
    Dim sFileName As String
    FileOperation.wFunc = &H3
    FileOperation.pFrom = FichierAMettreDansLaCorbeille
    FileOperation.fFlags = &H40 or &H10
    SHFileOperation FileOperation
End Sub

Sub test()
    Corbeille "F:\Atelier\Tralala.docx"
End Sub
Si vous désirez ne pas avoir de message de confirmation "Voulez-vous mettre ce fichier dans la corbeille, remplacez FileOperation.fFlags = &H40 par FileOperation.fFlags = &H40 or &H10

Vous pourrez envoyer aussi des dossiers (même remplis de fichiers ou d'autres sous-dossiers) avec la même méthode :

Corbeille "F:\Atelier\DossierQuelconque"

A partir de maintenant, vous pourrez utiliser la macro Corbeille, même si vous êtes dans un autre module VBA de ce même classeur Excel. Evidemment, si vous désirez utiliser Corbeille dans un autre programme Office ou même dans un autre classeur Excel, ça ne marchera plus, ou alors, il faudra recopier toute la partie du haut (Declare Function, et Sub Corbeille) dans votre nouveau Classeur ou document.

 

Ou alors, si vous désirez pouvoir utiliser la macro Corbeille en tout temps, dans Word et dans Excel, il faudra recopier ce code dans Personal.xlsb (pour Excel) et Normal.Dotm (pour Word), comme ceci :

Mais nous nous éloignons de notre sujet !

Plus d'informations en général sur l'utilisation des API : http://allapi.mentalis.org/

Parcourt de tous les fichiers d'un dossier

Nous n'avons pas besoin de FileSystemObject pour ce faire. Nous allons utiliser Dir. cette méthode peut être perturbante : La première fois qu'on l'invoque, le premier fichier du dossier est affiché. Ensuite, il suffit d'invoquer Dir une 2ème fois, et ainsi de suite, sans paramètre, pour obtenir les autres fichiers, comme ceci :

Sub QuatrePremiersFichiers()
    MsgBox Dir("F:\atelier\Armoire\*.*") ' Belle Photo.gif
    MsgBox Dir ' CommandePereNoel.txt
    MsgBox Dir ' fichiertest2.txt
    MsgBox Dir ' Logo.gif
End Sub

Afin d'être certain de parcourir tous les fichiers (mais pas les dossiers, donc), nous allons utiliser une boucle While (Tant que), de cette manière :

Sub ParcourtFichier()
    ' Fichier va contenir le nom du premier fichier rencontré dans F:\atelier
    Fichier = Dir("F:\atelier\*.*")
    ' Tant que Fichier est différent de vide (Tant qu'il y a un fichier à lire, simplement)
    While Fichier <> ""
          ' On l'affiche dans la fenêtre d'exécution (Affichage/Fenêtre exécution)
          Debug.Print Fichier
           ' Le fait de dire Fichier = Dir, sans préciser comme paramètre le nom du dossier,
                   ' permet de lire le fichier suivant :
         Fichier = Dir
    ' Et on revient dans la boucle en affichant le fichier qu'on vient de lire...
        ' S'il n'y avait qu'un seul fichier dans le dossier, il sortirait tout de suite maintenant.
    Wend
End Sub

Gestion des dossiers

Création d'un dossier

Ca se fait comme ceci :

Sub CreerDossier
    Dim GestionFichier As New Scripting.FileSystemObject
    GestionFichier.CreateFolder "F:\Atelier\Armoire"
    Set GestionFichier = Nothing
End Sub

Si vous exécutez deux fois de suite ce code, vous aurez une erreur étrange puisqu'il vous prétendra que le fichier existe déjà, alors qu'on fait c'est le dossier qui existe déjà (petit bug de message):

S'il y a une erreur dans le chemin d'accès, VBA se bloquera aussi sur un message d'erreur (ce qui est normal).

Méthode alternative sans FileSystemObject

Sub CreerDossierAlternatif()
    MkDir "F:\Atelier\Casimir"
End Sub

Suppression d'un dossier

Tout comme pour la création d'un dossier, on peut le faire avec ou sans FileSystemObject

Avec FileSystemObject :

Dim GestionFichier As New Scripting.FileSystemObject
GestionFichier.DeleteFolder "F:\Atelier\Armoire"
Set GestionFichier = Nothing

S'il y a des fichiers, ou même des sous-dossiers dans ce dossier, ils sont également effacés, et non pas mis dans la corbeille. Attention donc à cette commande, encore plus dangereuse que MoveFile !

Nous avons vu plus haut que, pour rendre la manoeuvre moins risquée, nous pouvons l'envoyer à la corbeille.

Sans FileSystemObject :

Avec RmDir (Acronyme de RemoveDirectory), par contre, il n'acceptera d'effacer le dossier que s'il est totalement vide :

RmDir "F:\Atelier\Armoire"

Copie de tout le contenu d'un dossier

Sub CopieDossier()
    Dim GestionFichier As New Scripting.FileSystemObject
    GestionFichier.CopyFolder "F:\Atelier\Depart", "F:\Atelier\Arrivee"
    Set GestionFichier = Nothing
End Sub

Si, dans le dossier Arrivee, il y avait déjà des fichiers de même nom que ceux du dossier Depart, les fichiers dans Arrivee seront purement et simplement écrasés par les nouveaux fichiers, sans le moindre message d'avertissement.

Le dossier de départ doit exister, sinon, une erreur "Chemin d'accès introuvable" surgit. Par contre, le dossier Arrivee ne doit pas obligatoirement exister. S'il n'existe pas, il est créé.

Tous les fichiers et éventuels sous-dossiers, ou même sous-sous-dossiers, et tous leurs fichiers seront copiés sans le moindre message d'avertissement.

Si, par exemple,  il y a le fichier aaa.txt dans le dossier Depart, et qu'il y a le fichier bbb.txt dans le dossier Arrivee, et qu'on demande à copier Depart dans Arrivee, le fichier bbb.txt va s'ajouter, sans supprimer du tout le fichier bbb.txt déjà existant.

Déplacement du contenu d'un dossier

Aussi étrange cela puisse-t-il paraître, le dossier de destination ne doit pas exister, sinon, une erreur "Fichier existe déjà" surgit !

Aussi, cette instruction risque de planter si Arrivee existe :

GestionFichier.MoveFolder "F:\Atelier\Depart", "F:\Atelier\Armoire\Arrivee"

Du coup, il faut s'assurer de la non-existence du dossier d'arrivee, et ensuite, on déplace, comme ceci :

Sub DeplaceDossier()
    Dim GestionFichier As New Scripting.FileSystemObject
    If GestionFichier.FolderExists("F:\Atelier\Armoire\Arrivee") Then
       GestionFichier.DeleteFolder("F:\Atelier\Armoire\Arrivee")
    End If
    ' Maintenant, nous sommes certains que le dossier Arrivee n'existe pas :
    GestionFichier.MoveFolder "F:\Atelier\Depart", "F:\Atelier\Armoire\Arrivee"
    Set GestionFichier = Nothing
End Sub

Du coup, faites attention, parce que comme nous effaçons le dossier Arrivee, le dossier Arrivee contiendra uniquement les fichiers et les éventuels sous-dossiers du dossier Depart : c'est donc différent de la copie de dossier que nous avons vu plus haut, ou le contenu de Depart est ajouté au dossier Arrivee.

Admettons la situation suivante : vous désirez déplacer tout le contenu du dossier Fruits et du dossier Légumes dans un nouveau dossier Nourriture : si vous désirez garder tous les fichiers des deux dossiers, vous ne pourrez donc pas utiliser MoveFolder, mais vous devrez copier les deux dossiers, et, à la fin, supprimer le dossier Fruit et Légume.

Voici le résultat final à obtenir :

Voici le code pour y parvenir :

Sub FusionDossiers()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' La première copie créera en même temps le nouveau dossier :
    GestionFichier.CopyFolder "F:\Atelier\Cuisine\Fruits", "F:\Atelier\Cuisine\Nourriture"
    ' Ici, il se contentera de copier et d'ajouter les fichiers de Légumes
    ' dans le dossier qui vient d'être créé
    GestionFichier.CopyFolder "F:\Atelier\Cuisine\Légumes", "F:\Atelier\Cuisine\Nourriture"
    ' Et maintenant, on efface les dossiers de base, devenus inutiles :    
    GestionFichier.DeleteFolder "F:\Atelier\Cuisine\Fruits"
    GestionFichier.DeleteFolder "F:\Atelier\Cuisine\Légumes"
    Set GestionFichier = Nothing
End Sub

Existence d'un dossier

On peut tester si un dossier existe ou pas.

Sub ExisteDossier()
    Dim GestionFichier As New Scripting.FileSystemObject
    MsgBox GestionFichier.FolderExists("F:\Atelier\Etagere") ' Faux
    GestionFichier.CreateFolder "F:\Atelier\Etagere"
    MsgBox GestionFichier.FolderExists("F:\Atelier\Etagere") ' Vrai
    GestionFichier.DeleteFolder "F:\Atelier\Etagere"
    MsgBox GestionFichier.FolderExists("F:\Atelier\Etagere") ' Faux
    Set GestionFichier = Nothing
End Sub

Création d'un dossier seulement s'il n'existe pas

Afin d'éviter une erreur VBA, on peut tester l'existence d'un dossier avant de le créer :

Sub DossierCreeSiExistePas()
    Dim GestionFichier As New Scripting.FileSystemObject
    If GestionFichier.FolderExists("F:\Atelier\Australie") = False Then
       GestionFichier.CreateFolder "F:\Atelier\Australie"
    End If
    Set GestionFichier = Nothing
End Sub

Traitement global d'un dossier

On accède à un dossier particulier avec GetFolder.

Sub DateCreation()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' Affichage de la date de création d'un certain dossier :
    MsgBox GestionFichier.GetFolder("F:\Atelier\Australie").DateCreated
    Set GestionFichier = Nothing
End Sub

Voici comment voir la date du dernier accès à un dossier :

MsgBox GestionFichier.GetFolder("F:\Atelier\Australie").DateLastAccessed

Il faut bien comprendre ce que veut dire "Dernier Accès" ! ... C'est la date, heure, minute et seconde de la dernière fois ou on a ouvert, ou modifié un fichier dans ce dossier, ou qu'on a créé ou renommé un sous-dossier dans ce dossier. En d'autres mots, le simple fait de cliquer sur le dossier dans l'explorateur ne change pas ce DateLastAccessed. Le fait de créer ou de modifier un fichier qui se trouverait dans un sous-dossier de ce dossier ne change pas ce paramètre DateLastAccessed non plus.

Taille totale des fichiers contenus dans un dossier

Cette ligne permet de connaître la taille en octets de l'ensemble de tous les fichiers, y compris ceux qui seraient placés dans des sous-dossiers de ce dossier (Un dossier vide est considéré comme mesurant 0 octet) :

MsgBox GestionFichier.GetFolder("F:\Atelier").Size

Nombre de fichiers dans un dossier

MsgBox GestionFichier.GetFolder("F:\Atelier\Australie").Files.Count

Nombre de sous-dossiers dans un dossier

MsgBox GestionFichier.GetFolder("F:\Atelier\Australie").SubFolders.Count

Parcourt des sous-dossiers directs d'un dossier

Cette macro permet d'afficher tous les sous-dossiers d'un dossier. Attention : elle ne liste pas les éventuels sous-dossiers d'un sous-dossier. Par exemple, si dans Atelier, il y a un sous-dossier Truc, dans lequel il y a un sous-dossier Machin, Truc sera affiché, mais pas Machin.

Sub ParcourtDossier()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' On commence par définir une variable de type Folder :
    Dim Dossier As Folder
    ' Cette boucle parcourt tous les dossiers contenus dans F:\Atelier :
    For Each Dossier In GestionFichier.GetFolder("F:\Atelier").SubFolders
        ' On affiche le nom du dossier courant dans la fenêtre exécution :
        Debug.Print Dossier.Name
    Next
    Set GestionFichier = Nothing
End Sub
Si on avait voulu afficher le chemin complet du dossier, plutôt que son simple nom, il aurauit fallu écrire Debug.Print Dossier.path au lieu de Debug.Print Dossier.Name

Dossiers spéciaux

Trois dossiers spéciaux existent sur les ordinateurs tournant sous Windows

On y accède à l'aide de GetSpecialFolder :

Sub DossiersSpeciaux()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' Chez moi : C:\Windows
    MsgBox GestionFichier.GetSpecialFolder(WindowsFolder)
    ' Chez moi : C:\Windows\System32
    MsgBox GestionFichier.GetSpecialFolder(SystemFolder)
    ' Chez moi : C:\Users\MichelD\AppData\Local\Temp
    MsgBox GestionFichier.GetSpecialFolder(TemporaryFolder)
    Set GestionFichier = Nothing
End Sub

Il existe une pléiade d'autres dossiers spéciaux (Mes documents, Ma musique, Menu démarrer, etc.) , mais pour y accéder automatiquement, il est nécessaire de passer par une API, et pas par Scripting.FileSystemObjects.

Copiez ceci dans un module VBA :

Private Declare Function _
SHGetSpecialFolderPath Lib "shell32.dll" Alias _
"SHGetSpecialFolderPathA" _
(ByVal hwndOwner As Long, ByVal lpszPath As String, _
ByVal nFolder As Long, ByVal fCreate As Long) As Long

Public Function DossierSpecial(ReferenceDossier As Long)
    Dim CheminAcces As String
    CheminAcces = Space(256)
    SHGetSpecialFolderPath hwnd, CheminAcces, ReferenceDossier, 0
    DossierSpecial = Left(CheminAcces, InStr(CheminAcces, Chr(0)) - 1)
End Function

Je ne vais pas expliquer ceci dans le détail car ce n'est pas le sujet, mais tout ce que je vous dis, c'est que maintenant, vous pouvez appeler la fonction  DossierSpecial avec, comme paramètre, le numéro de référence du dossier.

Par exemple, si vous désirez accéder au dossier Mes Documents (qui est référencé par le numéro 5), ça se passe comme ceci :

Sub GestionMesDocuments()
    ' Affichage de l'emplacement physique de Mes Documents :
    ' Moi, c'est : C:\Users\MichelD\Documents
    MsgBox DossierSpecial(5)
    
    ' Affichage du nombre de sous-dossiers contenus dans Mes Documents :
    Dim GestionFichier As New Scripting.FileSystemObject
    MsgBox GestionFichier.GetFolder(DossierSpecial(5)).SubFolders.Count
    Set GestionFichier = Nothing
    
    ' Affichage du premier fichier trouvé dans Mes Documents :
    ' Il faut bien penser à ajouter "/*.*" à la fin, sinon ça ne fonctionne pas :
    MsgBox Dir(DossierSpecial(5) & "\*.*")
    ' Affichage du fichier suivant :
    MsgBox Dir
End Sub

Vous aurez compris l'intérêt : si vous travaillez seul, en monoposte, évidemment qu'il ne sert à rien de faire tout ce Mic-Mac : il suffit de dire : MsgBox Dir("C:\Users\MichelD\Documents"), et le tour est joué, mais dès que vous travaillez en entreprise, et que votre macro doit être exécutée sur différents postes de travail, le nom de l'utilisateur change chaque fois.

Maintenant, je vous ai dit que le dossier spécial Mes Documents était référencé par le numéro 5. Mais quid de tous les autres dossiers spéciaux ? ... Pour les connaître, nous allons créer une petite macro qui va afficher les noms de tous les dossiers spéciaux, et leur numéro de référence :

Sub ListeDossiersSpeciaux()
    ' On doit initialiser une variable de comptage en Long, sinon, ça ne marche pas :
    Dim Compteur As Long
    ' Cette ligne fait en sorte que, en cas de numéro inexistant, il n'y ait pas
    ' d'erreur, mais qu'on passe à la suivante :
    On Error Resume Next
    ' On boucle de 1 jusqu'à 60 :    
    For Compteur = 1 To 60
        ' On affiche le compteur, deux points, et le dossier correspondant
        Debug.Print Compteur & " : " & DossierSpecial(Compteur)
    Next
End Sub

Le résultat est convainquant, voici un extrait (Constatez les "trous" : pas de Numéro 1, ni 3 ni 4, ... , ni 57, ni 58 (Allez savoir pourquoi) :

2 : C:\Users\MichelD\AppData\Roaming\Microsoft\Windows\Start Menu\Programs
5 : C:\Users\MichelD\Documents
6 : F:\DOCS\Configuration\Favoris bouton démarrer
7 : C:\Users\MichelD\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup
8 : C:\Users\MichelD\AppData\Roaming\Microsoft\Windows\Recent
   ...
   Etc...
   ...
55 : C:\Users\Public\Videos
56 : C:\Windows\resources
59 : C:\Users\Info3000\AppData\Local\Microsoft\Windows\Burn\Burn

Attributs et détails des fichiers et des dossiers

Nous allons utiliser Attributes. Voici, par exemple, comment créer un dossier invisible :

Sub CreerDossierInvisible()
    Dim GestionFichier As New Scripting.FileSystemObject
    GestionFichier.CreateFolder ("F:\Atelier\Dossier Invisible")
    GestionFichier.GetFolder("F:\Atelier\Dossier Invisible").Attributes = Hidden
    Set GestionFichier = Nothing
End Sub

 

 

C'est évidemment tout relatif, puisqu'il suffit d'aller dans l'explorateur Windows, et demander expressément de pouvoir visualiser les fichiers et dossiers cachés :

Si cette option est cochée, les fichiers et dossiers cachés apparaîtront simplement de manière plus pâlotte dans l'explorateur.

Voici comment définir un fichier en lecture seule :

Sub FichierLectureSeule()
    Dim GestionFichier As New Scripting.FileSystemObject
    GestionFichier.GetFile("F:\Atelier\CommandePereNoel.txt").Attributes = ReadOnly
    Set GestionFichier = Nothing
End Sub

Si on essaye d'ouvrir le fichier par la suite, il se laisse faire, et on peut même y apporter des modifications, mais on se rendra compte du Lecture Seule, seulement au moment d'enregistrer : il vous sera proposé naturellement d'enregistrer le fichier sous un nom différent.

J'ai essayé de définir un dossier en lecture seule, mais ça ne semble servir à rien . je peux toujours y placer et y modifier des fichiers, et je peux même le renommer (Je pense que la protection des dossiers est liée au compte d'utilisateur Windows, mais il me manque sans doute quelques connaissances au niveau du système d'exploitation pour vous en dire plus).

ReadOnly ne permet pas de modifier le fichier, par contre, vous pourrez le supprimer. Si vous mettez Attributes à System :

GestionFichier.GetFile("F:\Atelier\ListeChiffre.txt").Attributes = System

Vous pourrez à nouveau modifier votre fichier sans autre, par contre, vous ne pourrez plus l'effacer. Plus exactement, vous aurez un message différent lors de la tentative d'effacement du fichier. Sans l'attribut System, le message de droite apparaîtra en cas d'effacement du fichier :

Si l'attribut System est indiqué, vous aurez le message de gauche.

Il est peut-être possible que selon les configiurations des comptes Windows, vous ne puissiez simplement pas effacer un fichier dont l'attribut est fixé à System.

Si vous désirez attribuer plusieurs Attributs à un même fichier, il ne faut pas le faire comme ceci :

GestionFichier.GetFile("F:\Atelier\ListeChiffre.txt").Attributes = ReadOnly
GestionFichier.GetFile("F:\Atelier\ListeChiffre.txt").Attributes = System
GestionFichier.GetFile("F:\Atelier\ListeChiffre.txt").Attributes = Hidden

Parce que dans ce cas, il va juste attribuer l'attribut Hidden au fichier, mais pas readOnly ni System.

Si on veut à la fois rendre un fichier "invisible", déconseillé à effacer, et impossible à modifier, on doit procéder ainsi :

GestionFichier.GetFile("F:\Atelier\ListeChiffre.txt").Attributes = ReadOnly + System + Hidden

Méthode alternative sans FileSystemObjects

Voici comment changer les attributs d'un fichier de manière plus simpliste :

Sub ChangeAttributAlternatif()
    SetAttr "F:\Atelier\Test.txt", vbReadOnly + vbHidden
End Sub

Autres détails d'un fichier

Voici comment obtenir les différents éléments de fichiers :

Sub Elements()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' Extension du fichier, sans le point final : ici : txt
    MsgBox GestionFichier.GetExtensionName("F:\Atelier\ListePrenom.txt")
    ' Lettre de lecteur : ici : F:
    MsgBox GestionFichier.GetDriveName("F:\Atelier\ListePrenom.txt")
    ' Fichier + son extension : ici : ListePrenom.txt
    MsgBox GestionFichier.GetFileName("F:\Atelier\ListePrenom.txt")
    ' Lecteur et Dossier contenant le fichier : ici : F:\atelier
    MsgBox GestionFichier.GetFile("F:\atelier\ListePrenom.txt").ParentFolder
    Set GestionFichier = Nothing
End Sub

Assez étrangement, les 3 premiers exemples (GetExtensionName, GetDriveName et GetFileName) ne renvoient aucune erreur si le chemin d'accès et/ou le fichier n'existe pas :

MsgBox GestionFichier.GetExtensionName("W:\Dossierinexistant\FichierFantome.abc")
Afficherait bien abc. Par contre, le dernier exemple (affichage du dossier parent), exige un chemin et un fichier existants.

Taille des fichiers

Il existe deux manières d'obtenir la taille des fichiers. La macro suivante va vous afficher deux fois exactement la même chose :

Sub TailleFichier()
    ' Méthode 1 : sans besoin de FileSystemObject :
    MsgBox FileLen("F:\Atelier\Test.txt") ' En octets
    
    ' Méthode 2 : avec FileSystemObject :
    Dim GestionFichier As New Scripting.FileSystemObject
    MsgBox GestionFichier.GetFile("F:\Atelier\Test.txt").Size ' En octets
    Set GestionFichier = Nothing
End Sub

Parents

Dossiers parents

Il est possible d'afficher le dossier parent d'un dossier quelconque, comme ceci :

Sub Dossierparent()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' F:\ :
    MsgBox GestionFichier.GetFolder("F:\atelier\").ParentFolder
    ' F:\ : (Le \ est facultatif) 
    MsgBox GestionFichier.GetFolder("F:\atelier").ParentFolder
    ' F:\Atelier :
    MsgBox GestionFichier.GetFolder("F:\atelier\Armoire").ParentFolder
    ' Erreur : pas de parent pour le lecteur de disque :
    MsgBox GestionFichier.GetFolder("F:\").ParentFolder    
    Set GestionFichier = Nothing
End Sub

Ne vous trompez pas entre GetFile et GetFolder. la ligne suivante renvoie un erreur :

MsgBox GestionFichier.GetFolder("F:\atelier\ListeChiffre.txt").ParentFolder

En effet, GetFolder exige un nom de dossier en paramètre. Si on voulait connaitre le dossier parent du fichier ListeChiffre.txt (Le dossier contenant ce fichier, en fait), il aurait fallu écrire :

MsgBox GestionFichier.GetFile("F:\atelier\ListeChiffre.txt").ParentFolder

Dossiers grands-parents

Du coup, si vous aviez voulu afficher le dossier parent du dossier qui contient ListeChiffre.txt (F:\, donc), il aurait fallu écrire :

MsgBox GestionFichier.GetFolder(GestionFichier.GetFile("F:\atelier\ListeChiffre.txt").ParentFolder).ParentFolder

Lecteur parent

Il est aussi possible de récupérer la lettre de lecteur de n'importe quel fichier ou dossier. Dans les deux cas suivant, il va afficher F:

MsgBox GestionFichier.GetFile("F:\atelier\ListeChiffre.txt").Drive
MsgBox GestionFichier.GetFolder("F:\atelier").Drive
' Alternative fonctionnant avec un fichier ou un dossier en paramètre :
MsgBox GestionFichier.GetDriveName("F:\Atelier\")

Gestion des lecteurs

Propriétés des lecteurs

Toutes les propriétés s'obtiennent en utilisant GetDrive. Voici, par exemple, la syntaxe pour obtenir le numéro de série unique de votre disque dur C:

Sub ProprieteLecteur()
    Dim GestionFichier As New Scripting.FileSystemObject
    MsgBox GestionFichier.GetDrive("C").SerialNumber
    Set GestionFichier = Nothing
End Sub

Il est bien de commencer par s'assurer de l'existence de tel ou tel lecteur. Le C:, on est à peu près sûr qu'il existe, mais pas forcément d'autres :

Sub DisqueExiste()
    Dim GestionFichier As New Scripting.FileSystemObject
    If GestionFichier.DriveExists("F") Then
       MsgBox GestionFichier.GetDrive("F").SerialNumber
    End If
    Set GestionFichier = Nothing
End Sub

Espaces libres et occupés des lecteurs

Voici la syntaxe pour obtenir la taille totale de votre disque C:

MsgBox GestionFichier.GetDrive("C").TotalSize

Vous obtenez un chiffre énorme, car elle est exprimée en octets :

Je ne vais pas trop entrer dans les détails techniques de conversion, mais si vous désirez afficher la taille en Ko, vous devez diviser ce chiffre par 1024. ET 1024, c'est 2 puissance 10. Ca s'écrit comme ceci en VBA, vous pouvez tester :

' Si vous exécutez ceci, il vous affichera 1024 (Puissance = accent circonflexe suivi de la touche Espace) :
MsgBox 2 ^ 10

Sur le même principe, si vous désirez afficher la taille en Mo, vous devez diviser le nombre pas 2 ^ 20, et si vous désirez des Go, alors, vous divisez pas 2 ^ 30.

Voici l'affichage de la taille globale de mon C:, exprimée en Go :

MsgBox GestionFichier.GetDrive("C").TotalSize / (2 ^ 30)

Il y a trop de décimales ! Une seule suffit : Utilisons la fonction Format de cette manière :

MsgBox Format(GestionFichier.GetDrive("C").TotalSize / (2 ^ 30), "0.0")

Et, finalement, ajoutons "Taille totale :" au début, et "Go" à la fin, en utilisant l'opérateur de collage/concaténation & :

MsgBox "Taille totale : " & Format(GestionFichier.GetDrive("C").TotalSize / (2 ^ 30), "0.0") & " Go"

Le résultat est convainquant :

Espace disponible

Voici comment obtenir l'espace disque disponible :

MsgBox GestionFichier.GetDrive("C").FreeSpace

Un petit calcul vous permettra d'obtenir l'espace réellement utilisé par vos fichiers :

MsgBox GestionFichier.GetDrive("C").TotalSize - GestionFichier.GetDrive("C").FreeSpace

Listing des lecteurs disponibles

Voici comment connaître le nombre de lecteurs (Drives) que vous possédez:

Sub NombreLecteur()
    Dim GestionFichier As New Scripting.FileSystemObject
    MsgBox GestionFichier.Drives.Count
    Set GestionFichier = Nothing
End Sub

Parcours des lecteurs

Pourquoi les lettres commencent-elles par C: et pas par A: et B: ? Parce qu'il y a quelques années (1980/1990), nous avions des lecteurs de disquettes :

Nous pouvions en avoir deux, et ils s'appelaient systématiquement A: et B:. Aujourd'hui, ils ont disparu, mais leur lettre est toujours disponible.

 

 

 

Contrairement à ce qu'on pourrait imaginer, on ne peut pas parcourir les lecteurs par une simple boucle For To Next, comme ceci :

Sub MauvaiseMethode()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' On boucle de 1 jusqu'au nombre de lecteurs (Drives)
    For Ctr = 1 To GestionFichier.Drives.Count
        ' On affiche la taille totale du lecteur courant dans la fenêtre d'exécution
                ' (Que vous pouvez faire apparaître avec Affichage/Fenêtre exécution)
                ' Mais ça ne fonctionne pas !
        Debug.Print GestionFichier.Drives(Ctr).TotalSize
    Next
    Set GestionFichier = Nothing
End Sub
A la place, il est nécessaire de déclarer une variable-objet, et de parcourir les lecteurs avec la bouche For Each (Pour chaque lecteur) :
Sub BonneMethode()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' On déclare une variable de type Objet (Qui représentera un lecteur)
    Dim Lecteur As Object
    ' Pour (for) Chaque (Each) Lecteur dans la collection des Lecteurs (Drives)
    For Each Lecteur In GestionFichier.Drives
         ' On affiche la propriété TotalSize de cet objet Lecteur (Drive)
        Debug.Print Lecteur.TotalSize
    Next
    Set GestionFichier = Nothing
End Sub

Si nous déclarons Lecteur As Object, la macro va correctement s'exécuter, mais il y a un tout petit souci : lorsqu'on écrit Debug.print Lecteur. - A l'instant ou nous écrivons le point . , il n'y a pas l'auto-complétion ! Vous vous rappelez ? Nous avons eu un problème apparenté au début de la leçon ?. Pour remédier à cet inconvénient, remplacez

Dim Lecteur as Object

par

Dim Lecteur as Drive

Indépendamment de cette auto-complétion, si vous exécutez cette macro, vous risquez fortement d'obtenir une erreur : .

Evidemment, si votre lecteur de DVD ne contient pas de DVD, le lecteur existe, mais il n'est pas "prêt".

Aussi, vous devez utiliser la propriété IsReady, comme ceci:

Sub TestAvecIsReady()
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim Lecteur As Drive
    For Each Lecteur In GestionFichier.Drives
        If Lecteur.IsReady = True Then
           Debug.Print Lecteur.TotalSize
        End If
    Next
    Set GestionFichier = Nothing
End Sub

Voici ce qui sera affiché dans la fenêtre exécution : . Il faudrait au moins indiquer de quel lecteur il s'agit, comme ceci :

For Each Lecteur In GestionFichier.Drives
    If Lecteur.IsReady = True Then
       Debug.Print Lecteur.DriveLetter & " = " &  Lecteur.TotalSize
    End If
Next

Voici le résultat :

C = 127928365056
E = 198662144
F = 2000396742656

Mais ce serait bien d'afficher malgré tout, l'ensemble de toutes mes lettres de lecteurs existantes. Comme ceci :

Sub TestAvecIsReady()
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim Lecteur As Drive
    For Each Lecteur In GestionFichier.Drives
        If Lecteur.IsReady = True Then
           Debug.Print Lecteur.DriveLetter & " = " & Lecteur.TotalSize
        Else
           Debug.Print Lecteur.DriveLetter & " = VIDE"
        End If
    Next
    Set GestionFichier = Nothing
End Sub

Le résultat est convainquant :

C = 127928365056
D = VIDE
E = 198662144
F = 2000396742656
G = VIDE
Si vous désirez affiner l'affichage en Go ou en Mo, référez-vous au chapitre précédent.

Types de lecteurs

Sur votre PC, vous disposez d'un ou plusieurs disques durs, mais aussi de lecteurs/graveurs de CD ou de DVD, voire de disques USB externes, ou même de clés USB. Chacune de ces unités est représentée par une lettre (C:, D:, E:, ...)

Voici comment afficher le type de chacun de vos lecteurs :

Sub AfficheTypeLecteur()
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim Lecteur As Drive
    For Each Lecteur In GestionFichier.Drives
        Debug.Print Lecteur.DriveLetter & " = " & Lecteur.DriveType
    Next
    Set GestionFichier = Nothing
End Sub

Le résultat est obscur :

C = 2
D = 4
E = 4
F = 2
G = 1

En fait, chaque valeur désigne un support différent. Pour afficher la description correspondante, nous allons utiliser un Select Case, comme ceci :

Sub AfficheTypeLecteur()
  Dim GestionFichier As New Scripting.FileSystemObject
  Dim Lecteur As Drive
  ' Simple variable texte, qui va contenir les descriptions :
  Dim GenreLecteur As String
  F
or Each Lecteur In GestionFichier.Drives
    ' Selon la valeur de GestionFichier.Drives, qui contiendra donc 0,1,2,3,4,ou 5 :
    Select Case Lecteur.DriveType
      Case 0: GenreLecteur = "Type de lecteur impossible à déterminer ???"
      Case 1: GenreLecteur = "Disque dur amovible, ou simple clé USB"
      Case 2: GenreLecteur  = "Disque dur fixe, directement implanté dans votre PC"
      Case 3: GenreLecteur  = "Disque réseau, ne se trouvant pas forcément sur votre PC"
      Case 4: GenreLecteur  = "Lecteur ou graveur de CD ou de DVD"
      Case 5: GenreLecteur  = "Disque RAM(Disque virtuel, utilisant la mémoire vive du PC"
    End Select
    ' Maintenant, "GenreLecteur" contient la description du lecteur qu'on est en train de traiter
    ' On l'affiche en lieu et place du numéro incompréhensible :
    Debug.Print Lecteur.DriveLetter & " = " & GenreLecteur
  Next
  Set GestionFichier = Nothing
End Sub

Le résultat est convainquant. Voici ma structure :

C = Disque dur fixe, directement implanté dans votre PC
D = Lecteur ou graveur de CD ou de DVD
E = Lecteur ou graveur de CD ou de DVD
F = Disque dur fixe, directement implanté dans votre PC
G = Disque dur amovible, ou simple clé USB

Fichiers texte : Création, lecture, modification

Il est possible de créer, d'écrire et de lire le contenu de fichiers de type texte.

Pour faire mes tests, je suis toujours dans mon lecteur F:, et dans le dossier Atelier. Il faudra évidemment adapter vos essais à votre propre dossier de test.

Création d'un fichier texte et écriture d'une ligne dedans

L'exemple suivant crée un fichier appelé CommandePereNoel.txt, dans lequel nous écrivons le texte : Train électrique :

Sub CreationFichierTexte()
    Dim GestionFichier As New Scripting.FileSystemObject
    ' Nous déclarons une variable objet de type TextStream
    ' Nous aurions pu écrire : Dim FichierTexte As FileSystemObject.TextStream
    Dim FichierTexte As Scripting.TextStream
    ' Nous créons le fichier CommandePereNoel.txt, et l'attribuons à notre variable
    ' dans le but de lui faire subir des traitements ...
    Set FichierTexte = GestionFichier.CreateTextFile("F:\Atelier\CommandePereNoel.txt")
    ' ... En l'occurrence, d'écrire la seule et unique ligne : Train électrique
    FichierTexte.WriteLine ("Train électrique")
    ' Nous fermons le fichier :
    FichierTexte.Close
    Set GestionFichier = Nothing
End Sub

 

 

Si vous testez ce code, vous pourrez ensuite aller dans l'explorateur Windows, et constater que le fichier CommandePereNoel.txt existe bel et bien. Si vous cliquez deux fois dessus pour l'ouvrir, il va normalement l'ouvrir avec votre bloc-notes, et vous y verrez le contenu :

Si le fichier CommandePereNoel.txt existe déjà, il est écrasé. Si vous désirez obtenir un message d'erreur si le fichier existe, et qu'il ne soit pas écrasé, écrivez :

Set FichierTexte = GestionFichier.CreateTextFile("F:\Atelier\CommandePereNoel.txt", False)
Si le fichier existe, voici le message affiché :

Test de l'existence d'un fichier avec FileExists

FileExists permet de savoir si un fichier existe ou pas :

MsgBox GestionFichier.FileExists("F:\Atelier\CommandePereNoel.txt")

Affiche Vrai ou faux selon que le fichier existe ou pas.

AInsi, plutôt que de laisser VBA afficher un message d'erreur en cas de préexistence du fichier pour ne pas l'écraser, nous pouvons tester son existence avec un If :

Sub CreationFichierTexte()
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim FichierTexte As Scripting.TextStream
    If GestionFichier.FileExists("F:\Atelier\CommandePereNoel.txt") = False Then
       Set FichierTexte = GestionFichier.CreateTextFile("F:\Atelier\CommandePereNoel.txt")
       FichierTexte.WriteLine ("Train électrique")
       FichierTexte.Close
    End If
    Set GestionFichier = Nothing
End Sub

Ecriture dans un fichier déjà existant

Si vous avez un fichier texte qui existe déjà, dans lequel vous avez déjà des trucs écrits dedans : prenons l'exemple de CommandePereNoel.txt. C'est donc un fichier qui existe, et qui contient Train électrique.

Admettons qu'on veuille compléter la commande. ça se passe comme ça :

Sub AjoutDonnees()
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim FichierTexte As Scripting.TextStream
    Set FichierTexte = GestionFichier.OpenTextFile("F:\Atelier\CommandePereNoel.txt", ForAppending)
        FichierTexte.WriteLine ("Poupée")
        FichierTexte.WriteLine ("Voiture en plastique")
    FichierTexte.Close
    Set GestionFichier = Nothing
End Sub

ForAppending est un paramètre qui dit : "On va écrire à partir de la fin du texte existant". Si vous désiriez recommencer à écrire depuis le début du fichier (Effacer les données existantes pour les remplacer par de nouvelles), utilisez CreateTextFiles, comme nous l'avons vu juste avant : il va donc ainsi supprimer et recréer le même fichier.

Du coup, on peut dire que si le fichier n'existe pas, il le crée, et y écrit des données, et s'il existait déjà, on l'ouvre, et on écrit à la suite, comme ceci :

Sub SelonLesCas()
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim FichierTexte As Scripting.TextStream
    ' Si le fichier ListeCommissions existe :
    If GestionFichier.FileExists("F:\Atelier\ListeCommissions.txt") Then
       ' On l'ouvre avec OpenTextFile :
         Set FichierTexte = GestionFichier.OpenTextFile("F:\Atelier\ListeCommissions.txt", ForAppending)
Else ' Sinon ' On le crée avec CreateTextFile : Set FichierTexte = GestionFichier.CreateTextFile("F:\Atelier\ListeCommissions.txt") End If ' Qu'on l'ait ouvert avec OpenTextFile ou créé avec CreateTextFile, ' de toute façons, on y écrit Beurre : FichierTexte.WriteLine ("Beurre") FichierTexte.Close Set GestionFichier = Nothing End Sub

Si vous exécutez le code une première fois, il crée le fichier, et y écrit Beurre, et si vous réexécutez ce même code une 2ème, 3ème ou 4ème fois, il va rajouter toujours le mot Beurre plusieurs fois de suite, l'un en dessous de l'autre, sans jamais donner d'erreur.

WriteLine est une méthode permettant d'écrire une donnée par ligne : Poupée et Voiture en Plastique sont écrites l'une en dessous de l'autre.

Il est possible d'écrire les données l'une à côté de l'autre. Essayez ceci :

Sub ParLigneParMot()
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim FichierTexte As Scripting.TextStream
    Set FichierTexte = GestionFichier.CreateTextFile("F:\Atelier\ListeChiffre.txt")
    FichierTexte.WriteLine ("Un")
    FichierTexte.Write ("Deux")
    FichierTexte.Write ("Trois")
    FichierTexte.Write ("Quatre")
    FichierTexte.WriteLine ("Cinq")
    FichierTexte.WriteLine ("Six")
    FichierTexte.Close
    Set GestionFichier = Nothing
End Sub

Lancement automatique du bloc-notes

on pourrait directement appeler le bloc-notes avec, en paramètre, le nom de notre fichier, afin de gagner du temps :

    [...]
    FichierTexte.WriteLine ("Six")
    FichierTexte.Close
    Set GestionFichier = Nothing
    Shell "notepad.exe F:\Atelier\ListePrenom.txt", vbNormalFocus
 End Sub

Le fait d'écrire WriteLine Quelque chose, ajoute en fin de ligne un retour-chariot : c'est pour ça que deux est écrit à la ligne. Cinq est, pour sa part, écrit en fin de ligne car Write n'a, a contrario, pas ajouté de caractère de saut de ligne.

Exécution de n'importe quel type de fichier

Il est possible de lancer/exécuter tout type de fchier, et pas seulement les .txt avec NotePad.

Voici comment visualier une image jpg :

Shell "explorer.exe " & "F:\Atelier\belle image.jpg"

Avec ce même explorer.exe, vous pourrez lancer ce que vous voulez : des documents Word, des classeurs Excel, des fichiers txt, un peu comme si vous double cliquiez sur le fichier en question dans votre explorateur.

Lecture du contenu d'un fichier texte

Commençons par créer un fichier texte tout simple, composé de 4 lignes de textes:

Sub CreationPrenom()
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim FichierTexte As Scripting.TextStream
    Set FichierTexte = GestionFichier.CreateTextFile("F:\Atelier\ListePrenom.txt")
        FichierTexte.WriteLine ("André")
        FichierTexte.WriteLine ("Bernard")
        FichierTexte.WriteLine ("Charlotte")
        FichierTexte.WriteLine ("Danielle")
    FichierTexte.Close
    Set GestionFichier = Nothing
End Sub

Voici comment le lire, ligne par ligne :

Sub LectureTroisLignes()
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim FichierTexte As Scripting.TextStream    
    Set FichierTexte = GestionFichier.OpenTextFile("F:\Atelier\ListePrenom.txt", ForReading)
        MsgBox FichierTexte.ReadLine ' André
        MsgBox FichierTexte.ReadLine  ' Bernard
        MsgBox FichierTexte.ReadLine  ' Charlotte
    FichierTexte.Close
    Set GestionFichier = Nothing
End Sub

Evidemment, on va rapidement tomber sur une erreur quand on va dépasser Danielle. Il s'agit donc plutôt de lire en boucle toutes les lignes jusqu'à ce qu'on tombe sur la fin du fichier, grâce à AtEndOfStream, comme ceci :

Sub LectureToutFichier()
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim FichierTexte As Scripting.TextStream
    Set FichierTexte = GestionFichier.OpenTextFile("F:\Atelier\ListePrenom.txt", ForReading)
    While FichierTexte.AtEndOfStream = false
          Debug.Print FichierTexte.ReadLine
    Wend
    FichierTexte.Close
    Set GestionFichier = Nothing
End Sub

On peut aussi lire un certain nombre de caractères à la fois, grâce à Read, comme ceci :

Set FichierTexte = GestionFichier.OpenTextFile("F:\Atelier\ListePrenom.txt", ForReading)
    MsgBox FichierTexte.Read(3) ' Lit les 3 premiers caractères ("And" de "André")
    MsgBox FichierTexte.Read(5) ' Lit les 5 caractères suivants

Le premier MsgBox est sans surprise, mais le 2ème laisse songeur : en effet, après avoir affiché And, on se serait attendu a ce que les 5 caractères suivants soient "réBer" (Les 2 dernières lettres d'André et les 3 premières de Bernard.

En réalité, le retour chaiot compte carrément pour ... DEUX caractères. Donc, ré (2 caractères + 2 caractères de retour à la ligne " + la première lettre de Bernard (B), ça fait bien 5 caractères.

Finalement, on peut récupérer carrémenttout l'ensemble du fichier d'un seul coup :

MsgBox FichierTexte.ReadAll

Modification d'un fichier : Complications obligatoires

Il n'est pas possible d'ouvrir un fichier en écriture et d'écrire par dessus une ligne existante : on doit choisir entre "Réécrire dans le fichier, mais il est donc vidé de son contenu", ou "Ecrire de nouvelles lignes à la fin du fichier" !

Voici comment contourner cette limitation :

Admettons que nous désirions remplacer Charlotte par Caroline. Nous allons donc transférer notre fichier, ligne par ligne, dans un tableau, comme ceci :

Sub ModificationFichier()
    ' On déclare un tableau de texte (String) dont on ne connait pas
    ' encore la taille (Ca va dépendre du nombre de prénoms :
    Dim LectureLigne() As String
    ' le nombre de prénoms (nombre de lignes du fichier) sera indiqué ici :
    Dim NombrePrenom As Integer
    ' Initialisons-le à 0 :
    NombrePrenom = 0
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim FichierTexte As Scripting.TextStream
    ' Nous commençons par ouvrir le fichier en lecture :
    Set FichierTexte = GestionFichier.OpenTextFile("F:\Atelier\ListePrenom.txt", ForReading)
    ' Nous allons le lire ligne par ligne, jusqu'à la fin AtEndOfStream :
    While FichierTexte.AtEndOfStream = False
          ' Passons de 0 à 1 pour le nombre de prénoms, nous passerons de 1 à 2, etc. :
          NombrePrenom = NombrePrenom + 1
          ' Redéfinissons (ReDim) la taille du tableau LectureLigne en
                    ' NombrePrenom (1, donc, à ce premier tour du While). On doit
                    ' écrire Preserve pour ne pas que ce tableau soit vidé en même
                    ' temps qu'il grossit (c'est bizarre mais c'est ainsi) :
          ReDim Preserve LectureLigne(NombrePrenom)
           ' Mettons la ligne actuellement lue (FichierTexte.ReadLine) dans le
                      ' Tableau, au Numéro NombrePrenom (1, donc, toujours - soit : André) :
           LectureLigne(NombrePrenom) = FichierTexte.ReadLine
           ' Si c'est Charlotte, il faut le remplacer, l'écraser
                     ' Par Caroline. Bon, là, c'est André, donc il ne fait rien
          If LectureLigne(NombrePrenom) = "Charlotte" Then
             LectureLigne(NombrePrenom) = "Caroline"
          End If
    ' Et voilà ! Maintenant, il recommence au while, et on fait tout pareil, sauf que
        ' maintenant, NombrePrenom est à 2, et on fait les mêmes traitements qu'avec la première
        ' ligne, mais avec la 2ème, et ainsi de suite jusqu'à la fin du fichier,
        ' c'est à dire au 4ème prénom.
        ' Et quand il arrivera au 3ème, ce sera Charlotte, le If va la remplacer en Caroline
    Wend
    
    ' Maintenant, on écrase carrément comme un sauvage le fichier :
    Set FichierTexte = GestionFichier.CreateTextFile("F:\Atelier\ListePrenom.txt")
    ' On compte de 1 jusqu'au plus grand indice du tableau, son plus grand numéro (avec une variable "Compteur")
        ' C'est à dire que c'est 4, en fait (Vous vous rappelez ? Redim Preserve.
    For Compteur = 1 To UBound(LectureLigne)
        ' Et on réécrit tout, ligne par ligne, bêtement !
                ' Et comme on a déjà remplacé, dans notre 3ème élément de tableau,
                ' Charolotte par Caroline avec le If, plus haut, on ne se pose plus de questions :
        FichierTexte.WriteLine (LectureLigne(Compteur))
    Next
    
    FichierTexte.Close
    Set GestionFichier = Nothing
    ' Voilà ! Si vous rouvrez votre fichier, vous verrez, il contient bien tous les prénoms,
        ' comme avant, avec juste Caroline à la place de Charlotte.
End Sub

Gestion de fichiers textes : ancienne méthode

Il y a quelques années, nous n'utilisions pas la bibliothèque FileSystemObjects. Voici la marche à suivre alternative pour créer, ajouter et lire du texte dans un fichier texte. Cette méthode ne nécessite donc pas Dim GestionFichier As New Scripting.FileSystemObject :

Sub GestionFichierTexteMethodeAlternative()
    ' PARTIE 1 : Création du fichier :
        ' Ouverture de tadaga.ini, et écriture de Abricot et banane
        ' Si le fichier n'existait pas, il est créé
        ' s'il existait et qu'il contenait des données, elles seront remplacées
    Open "F:\atelier\tagada.ini" For Output As #1
    Print #1, "Abricot"
    Print #1, "Banane"
    Close #1
    
    ' PARTIE 2 : Ajout de texte à la fin du fichier :
        ' Idem que la partie 1, si le fichier n'existe pas, il est créé, mais cette fois, 
        ' s'il existe et qu'il y avait déjà des données dedans, les nouvelles seront 
        ' rajoutées à la fin :
    Open "F:\atelier\tagada.ini" For Append As #1
    Print #1, "Cacahuète"
    Print #1, "Melon"
    Close #1
    
    ' PARTIE 3 : Lecture du fichier, ligne par ligne :
        ' Ouverture de Tagada.ini en lecture. S'il n'existe pas, une erreur est générée
        ' S'il existe, il est lu ligne par ligne :
    
    Open "F:\atelier\tagada.ini" For Input As #1
    ' Tant que End Of File (EOF) du fichier No1 n'est pas atteint :
    While EOF(1) = False
      ' On transfère la ligne courante dans la variable LigneCourante
      Line Input #1, LigneCourante
      debug.print LigneCourante
    Wend ' On lit la ligne suivante du fichier
    Close #1
End Sub

Le #1 représente une référence unique au fichier. Il est ainsi possible de faire référence à plusieurs fichiers en même temps.

Admettons que nous ayons deux fichiers existants (Fruits.txt et Légumes.txt), et que nous désirions créer un nouveau fichier Nourriture.txt, qui contient toutes les données de fruits.txt, suivie de toutes les données de légumes.txt :

Comme ceci :

Sub TroisFichiers()
    ' Variables qui serviront à récupérer le contenu des fichiers
    ' ligne par ligne :
    Dim FruitCourant As String
    Dim LegumeCourant As String
    
    ' Attribution de numéros à nos 3 fichiers :
    ' Fuits.txt et Légumes.txt sont ouverts en lecture :
    Open "F:\atelier\Fruits.txt" For Input As #1
    Open "F:\atelier\Légumes.txt" For Input As #2
    ' Nourriture.txt n'existe pas encore, on le crée
    ' (ou on écrase l'éventuel existant) et on l'ouvre en écriture :
    Open "F:\atelier\Nourriture.txt" For Output As #3
    
    ' On lit Fruit.txt ligne par ligne :
    While EOF(1) = False
      ' On place le fruit courant (la ligne courante) dans la variable :
      Line Input #1, FruitCourant
      ' Et cette variable, on l'écrit dans le fichier N°3 (Nourriture.txt) :
      Print #3, FruitCourant
    Wend
    
    ' On fait la même chose avec Légume.txt, qui porte le numéro 2 :
    While EOF(2) = False
      Line Input #2, LegumeCourant
      Print #3, LegumeCourant
    Wend
    
    Close #1  ' On ferme Fruits.txt
    Close #2  ' On ferme Légumes.txt
    Close #3  ' On ferme Nouriture.txt (Qui est mainteannt rempli de fruits et de légumes)
End Sub
A la place d'écrire Close #1, Close #2 et Close #3, nous aurions pu écrire juste Reset (Fermeture de tous les fichiers et écriture physique sur disque des éventuelles données restantes)

Boîtes de dialogues intégrées de choix de fichiers/Dossiers

Grâce à Application.FileDialog, nous allons pouvoir sélectionner facilement un ou plusieurs fichiers ou dossiers.

Attention : Si vous travaillez dans VBA Access, il vous faudra préalablement aller dans l'environnement VBA, et expressément aller dans le menu Outils/Références, et cocher la case "Microsoft Office 14.0 Object Library".

Simple affichage de la boîte de dialogue

Sub ChoixFichierBase()
    Application.FileDialog(msoFileDialogFilePicker).Show
End Sub

 

 

Si vous exécutez cette macro, une boîte de dialogue de choix de fichier apparaîtra, comme ceci :

 

 

Si vous cliquez ensuite sur le bouton Ouvrir, ou Annuler, la boîte disparaît, simplement.

Affichage du fichier choisi

Après le .Show, nous pouvons afficher le fichier choisi. Pourquoi ce SelectedItems(1) ? Ca veut dire qu'il peut y en avoir plusieurs ? Oui, parfois, mais nous le verrons plus tard.

Lancez cette macro, cliquez sur un fichier (Moi, j'ai cliqué sur Fruits.txt, dans le dossier Atelier), et cliquez sur Ouvrir :

Sub AfficherFichier()
    Application.FileDialog(msoFileDialogFilePicker).Show
    MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
End Sub

Gestion du bouton Annuler

Si vous cliquez sur Annuler, une erreur surgira :

 

Pour éviter cette erreur, il faut ajouter un If, comme ceci :

Sub GestionAnnuler()
    If Application.FileDialog(msoFileDialogFilePicker).Show = True Then
       MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
    End If
End Sub

Titre de la boîte de dialogue

 

 

Sub Titre()
    Application.FileDialog(msoFileDialogFilePicker).Title = "Choisisez un beau fichier"
    If Application.FileDialog(msoFileDialogFilePicker).Show = True Then
       MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
    End If
End Sub

Personnalisation du bouton Ouvrir

Sub BoutonPersonnalise()
    Application.FileDialog(msoFileDialogFilePicker).Title = "Choisisez un beau fichier"
    Application.FileDialog(msoFileDialogFilePicker).ButtonName = "Traitement"
    If Application.FileDialog(msoFileDialogFilePicker).Show = True Then
       MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
    End If
End Sub

On ne peut pas personnaliser, ni supprimer le bouton annuler.

le nouveau nom du bouton n'apparaît pas tout de suite ! Si vous exécutez cette macro, le bouton sera toujours intitulé "Ouvrir", mais il s'affichera en "Traitement", dès l'instant ou vous cliquez (sélectionnez) un fichier. Si vous sélectionnez un dossier, le nom du bouton redevient "Ouvrir" à nouveau. Bizarre, mais c'est ainsi.

La boîte de dialogue garde les paramètres en mémoire

Faites attention à ce phénomène : Voici deux macros :

Sub Premier()
    Application.FileDialog(msoFileDialogFilePicker).Title = "Banane"
    Application.FileDialog(msoFileDialogFilePicker).Show
End Sub
Sub Deuxieme()
    Application.FileDialog(msoFileDialogFilePicker).ButtonName = "Kiwi"
    Application.FileDialog(msoFileDialogFilePicker).Show
End Sub

Si vous exécutez la première Macro, le titre de la boîte de dialogue est bien Banane.

Bien. Maintenant, si vous exécutez la 2ème macro, le bouton devient bien Kiwi (Dès que vous aurez cliqué sur un fichier), mais, de plus, le titre de la fenêtre est resté à Banane !

Mais si vous quittez Excel, et que vous le rouvrez, et que vous exécutez immédiatement la macro Deuxieme, alors, le titre de la boîte de dialogue par défaut . Parcourir, va s'afficher.

Raccourcissement avec With - End With

Comme nous faisons subitr plusieurs éléments de personnalisation à notre boîte de dialogue, nous allons raccourcir quelque peu la syntaxte avec With et End With. Remplacez :

Sub Verbeux()
    Application.FileDialog(msoFileDialogFilePicker).Title = "Choisisez un beau fichier"
    Application.FileDialog(msoFileDialogFilePicker).ButtonName = "Traitement"
    If Application.FileDialog(msoFileDialogFilePicker).Show = True Then
       MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
    End If
End Sub

Par le code suivant, qui produit strictement le même résultat :

Sub Raccourci()
    With Application.FileDialog(msoFileDialogFilePicker)
         .Title = "Choisisez un beau fichier"
         .ButtonName = "Traitement"
         If .Show = True Then
            MsgBox .SelectedItems(1)
         End If
    End With
End Sub

Emplacement initial / Fichier par défaut

Vous pouvez décider du dossier dans lequel on se trouvera, à l'instant de l'affichage de la boîte de dialogue, grâce à InitialFileName :

Sub EmplacementInitial()
    Application.FileDialog(msoFileDialogFilePicker).InitialFileName = "F:\Atelier"
    Application.FileDialog(msoFileDialogFilePicker).Show
End Sub

 

Vous pouvez même affiner en sélectionnant carrément un fichier, ou une série de fichiers par défaut. Voici comment afficher par défaut les fichiers commençant par la lettre L, et se terninant par txt :

 

Application.FileDialog(msoFileDialogFilePicker).InitialFileName = "F:\Atelier\L*.txt"

Filtres

Il est possible de sélectionner des filtres de fichiers. Par exemple, si je veux que, lors du choix, il ne me montre que certains fichiers d'images (Qui se terminent par .Jpg ou par .Gif), je ferais comme ceci :

Sub Filtres()
    With Application.FileDialog(msoFileDialogFilePicker)
        ' On commence par effacer les filtres. Si on ne fait pas ça, quand on lance
        ' cette macro plusieurs fois de suite, les mêmes filtres vont s'empiler en doublon :
        .Filters.Clear
        ' On propose le choix de filtre des fichiers se terminant par gif, jpg ou jpeg :
        .Filters.Add "Belles images", "*.gif,*.jpg,*.jpeg"                      ' (1)
        ' On ajoute le choix de filtres des fichiers Word et texte :
        ' (peu importe qu'on mette une virgule ou point-virgule entre les filtres)
        .Filters.Add "Documents Word et textes", "*.doc; *.docm; *.docx;*.txt"  '(2)
        ' Et, enfin, on propose de voir tous les fichiers :
        .Filters.Add "Tout ce qui existe comme fichiers", "*.*"                 ' (3)
        ' Pour affiner, on filtre par défaut par le deuxième choix de filtres,
        
        ' en l'occurrence : Les documents Word
        .FilterIndex = 2
        .Show
    End With
End Sub

 

Assez étrangement, on ne peut pas mettre n'importe quoi comme filtre. Par exemple, un filtre de tous les fichiers commençant par L renvoie une erreur :

.Filters.Add "Fichiers commençant par L", "L*.*"

Comme on ne peut pas mettre n'importe quel genre de filtres, comme on vient de le voir, il est, par contre, possible de combiner le fichier par défaut et les filtres.

L'exemple suivant nous montre tous les fichiers textes commençant par L, et propose le filtre "Images Jpeg" :

Sub FiltreEtFichierParDefaut()
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "F:\Atelier\L*.txt"
        .Filters.Clear
        .Filters.Add "Belles images", "*.jpg"
        .Show
    End With
End Sub

Sélection de plusieurs fichiers

Il peut être parfois utile de pouvoir sélectionner plusieurs fichiers à la fois. Pour ce faire, nous allons utiliser AllowMultiSelect, comme ceci :

Sub MultiSelection()
    Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = True
    Application.FileDialog(msoFileDialogFilePicker).Show
End Sub

En fait, même si vous ne le spécifiez pas, par défaut, la boîte de dialogue accepte la multi-sélection. C'est donc surtout lorsque vous désirez que l'utilisateur ne sélectionne qu'un fichier qu'il faaut indiquer .AllowMultiSelect = False !

Pour sélectionner plusieurs fichiers à la fois :

  1. Cliquez sur le premier fichier que vous désirez sélectionner
  2. Lâchez la souris
  3. Appuyez sur la touche de votre clavier
  4. Laissez le doigt appuyé sur la touche !!!
  5. Cliquez sur le 2ème fichier que vous désirez sélectionner
  6. Lâchez la souris
  7. Laissez toujours le doigt appuyé sur la touche !!!
  8. Cliquez sur le 2ème fichier que vous désirez sélectionner
  9. Lâchez la souris
  10. Vous pouvez enfin arrêter d'appuyer sur

Voici une autre technique pour sélectionner d'un seul coup toute une série de fichiers. Je vais sélectionner tous les fichiers de Nourriture.txt à Liste commissions.txt :

  1. Cliquez sur le premier fichier que vous désirez sélectionner (Nourriture.txt)
  2. Lâchez la souris
  3. Appuyez sur la touche majuscule de votre clavier
  4. Laissez le doigt appuyé sur la touche !!!
  5. Cliquez sur le dernier fichier de la série (ListeCommissions.txt)
  6. Lâchez la souris
  7. Vous pouvez enfin arrêter d'appuyer sur

Voici comment récupérer les fichiers sélectionnés.

Sub AffichePlusieursFichiers()
    Application.FileDialog(msoFileDialogFilePicker).Filters.Add "tout", "*.*"
    With Application.FileDialog(msoFileDialogFilePicker)
         .AllowMultiSelect = True
         .Show
         ' La numérotation se fait dans le même ordre que les clics de souris :
         MsgBox .SelectedItems(1) ' zozios.jpg
         MsgBox .SelectedItems(2) ' Légumes.txt
         MsgBox .SelectedItems(3) ' Une erreur est générée
    End With
End Sub

Le plus rationnel est de faire une boucle, afin de récupérer le bon nombre de fichiers sélectionnés :

Sub MultiSelection()
    With Application.FileDialog(msoFileDialogFilePicker)
         .AllowMultiSelect = True
         .Show
         For Compteur = 1 To .SelectedItems.Count
             MsgBox .SelectedItems(Compteur)
         Next
    End With
End Sub

Subtilités des différentes boîtes de dialogue

On peut faire apparaître plusieurs types de boîtes de dialogue différentes :

Sub DifferenceBoites()
    Application.FileDialog(msoFileDialogFilePicker).Title = "msoFileDialogFilePicker"
    Application.FileDialog(msoFileDialogFilePicker).Show
    
    Application.FileDialog(msoFileDialogOpen).Title = "msoFileDialogOpen"
    Application.FileDialog(msoFileDialogOpen).Show
    
    Application.FileDialog(msoFileDialogFolderPicker).Title = "msoFileDialogFolderPicker"
    Application.FileDialog(msoFileDialogFolderPicker).Show
    
    Application.FileDialog(msoFileDialogSaveAs).Title = "msoFileDialogSaveAs"
    Application.FileDialog(msoFileDialogSaveAs).Show
End Sub

Voici les petites différences qui apparaissent pour les unes et les autres :

Sélection de dossier

Pour sélectionner un dossier on doit donc utiliser msoFileDialogFolderPicker

Application.FileDialog(msoFileDialogFolderPicker).Show
MsgBox Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)

Si vous essayez de sélectionner un dossier avec msoFileDialogFilePicker, et que vous cliquez sur un dossier, lorsque vous cliquerez sur le bouton de validation, il va simplement se rendre dans le dossier correspondant afin de vous afficher la liste des fichiers :

Sub DossierIncorrect()
    Application.FileDialog(msoFileDialogFilePicker).Show
    MsgBox Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
End Sub

Exemple complet

Voici un exemple résumant toutes les notions vues au cours de la section des boîtes de dialogues de sélection de fichiers :

Sub ExempleComplet()
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Exemple complet" ' Barre de titre
        .ButtonName = "Lister les fichiers" ' Texte du bouton
        ' Filtres :
        ' On va dans F:\Atelier, et on liste par défaut tous les fichiers
        ' qui commencent par L :
        .InitialFileName = "F:\Atelier\L*.*"
        .Filters.Clear ' Effacement par sécurité des filtres
        .Filters.Add "Belles images", "*.gif,*.jpg,*.jpeg" ' 1
        .Filters.Add "Documents Word et textes", "*.doc; *.docm; *.docx; *.txt" ' 2
        .Filters.Add "Tout", "*.*" ' 3
        ' Ce FilterIndex est inopérant car écrasé par InitialFileName :
        .FilterIndex = 2 ' Sinon, on aurait affiché les fichiers Word et Texte par défaut
        .AllowMultiSelect = True ' On  peut sélectionner plusieurs fichiers
        
        If .Show = True Then ' Si on a cliqué sur Annuler, on n'entre pas dans le If
           ' On compte de 1 jusqu'au nombre de fichiers sélectionnés
           For Compteur = 1 To .SelectedItems.Count
               ' On affiche chaque fichier dans la fenêtre exécution
               Debug.Print .SelectedItems(Compteur)
           Next
        End If ' .Show
    End With ' With Application.FileDialog(msoFileDialogFilePicker)
End Sub

Recherche de fichiers/Dossiers

Jusqu'à la version d'Office 2003, nous disposions d'une très intéressante fonction FileSearch, qui permettait de rechercher des fichiers et des dossiers dans toute une arborescence de fichiers et de dossiers. Cette fonction a, pour des raions que j'ignore, disparu.

Imaginez que vous deviez rechercher un fichier appelé Facture Dupont.xlsx dans tous vos dossiers et sous-dossiers, ça ne va pas être facile à réaliser en VBA, sans cette précieuse fonction FileSearch.

Je vous propose ici une très intéressante alternative, qui vous permettra ce genre de recherches très aisément. La conception de ces macros font appel à des notions de programmation trop complexes et trop hors-sujet pour que je les explique ici (La récursivité et les modules de classe)

Ne vous en faites donc pas : pas de complication à l'horizon !

Marche à suivre

Création d'un module de classe

Commencez par créer un module de classe (Peu importe que vous soyez dans Word, Excel ou Access) :

Renommez ce module en Recherche :

Dans ce nouveau module de classe, copiez-y le code suivant, ici plus bas :

Public ListeDossier As New Collection
Public ListeFichier As New Collection
Public ListeDossierFichier As New Collection

Public Sub Analyse(Dossier)
    Set GestionFichier = CreateObject("Scripting.FileSystemObject")
    AnalyseDossier GestionFichier.GetFolder(Dossier), ListeDossier
    
    On Error Resume Next
    For Ctr = 1 To ListeDossier.Count
        For Ctr2 = 1 To GestionFichier.GetFolder(ListeDossier(Ctr)).Files.Count
            If compte Mod 1000 = 0 Then
               DoEvents
            End If
            If Ctr2 = 1 Then
               FichierSuivant = Dir(ListeDossier(Ctr) & "\*.*")
            Else
               FichierSuivant = Dir
            End If
            ListeFichier.Add FichierSuivant
            ListeDossierFichier.Add ListeDossier(Ctr) & "\" & FichierSuivant
        Next
    Next
    Set GestionFichier = Nothing
End Sub

Private Sub AnalyseDossier(QuelDossier As Folder, ByRef ListeDossier As Collection)
    Dim Dossier As Folder
    For Each Dossier In QuelDossier.SubFolders
        AnalyseDossier Dossier, ListeDossier
    Next
    ListeDossier.Add QuelDossier.path
End Sub

Private Sub class_Terminate()
    Set ListeDossier = Nothing
    Set ListeFichier = Nothing
    Set ListeDossierFichier = Nothing
End Sub

Je ne commente donc pas ce code (Trop complexe et hors sujet), mais nous allons apprendre à l'utiliser !

Créez maintenant un nouveau module (pas un module de classe), peu importe son nom.

... Ou rendez-vous dans un module déjà créé, peu importe. L'important est de ne pas être dans le module de classe.

Arborescence d'exemple

Pour l'exemple, j'ai créé quelques fichiers et quelques dossiers : J'ai créé un dossier Maison dans mon lecteur F:, et j'y ai créé quelques fichiers et sous-dossiers, comme ceci :

Parmi tout ce beau monde, Il y a donc un dossier vide (Commode), et un dossier Tiroir 2 qui ne contient qu'un dossier (Classeur).

Vous pouvez télécharger ce fichier maison.zip, et le décompresser à la racine de votre disque dur : c'est cette arborescence complète, comme dans le dessin de droite :

Nous sommes en présence d'un total de 6 dossiers, et 8 fichiers, répartis un peu au hasard.

Recopiez le code suivant dans votre nouveau Module (pas l'objet, l'autre), en remplaçant F:\Maison par un dossier de votre choix.

Si vous choisissez un dossier très volumineux (C:\Windows par exemple), la macro peut mettre un certain temps, voire un temps certain à se terminer
Vous devez sélectionner un dossier. Vous ne pouvez pas lancer une recherche avec un lecteur : MaRecherche.Analyse "F:\" renvoie une erreur (C'est une amélioration possible à implémenter dans le module de classe, mais je ne l'ai pas fait).
Sub TestUtilisationClasseRecherche()
    Dim MaRecherche As New Recherche
    MaRecherche.Analyse "F:\Maison"
    Set MaRecherche = Nothing
End Sub

Si vous exécutez ce code, il ne se passe rien, mais il n'y a pas d'erreur.  En fait, il a rempli ListeFichier, ListeDossier et ListeDossierFichier avec tous les fichiers et dossiers qu'il a trouvé dans l'arborescence.

Nombre total de dossiers et de fichiers

Cette macro vous affichera dans la fenêtre exécution (Affichage/Fenêtre exécution) le nombre de dossiers (6) et de fichiers (8) :

Sub Comptage()
    Dim MaRecherche As New Recherche
    MaRecherche.Analyse "F:\Maison"
    Debug.Print MaRecherche.ListeDossier.Count
    Debug.Print MaRecherche.ListeFichier.Count
    Set MaRecherche = Nothing
End Sub
6
8

Affichage de tous les dossiers et fichiers

Maintenant, vous avez la possibilité d'afficher tous les dossiers, en parcourant, à l'aide d'une boucle, tous les éléments de ListeDossier, comme ceci :

Sub ListingDossier()
    Dim MaRecherche As New Recherche
    MaRecherche.Analyse "F:\Maison"
    For Ctr = 1 To MaRecherche.ListeDossier.Count
        Debug.Print MaRecherche.ListeDossier(Ctr)
    Next
    Set MaRecherche = Nothing
End Sub

Qui donne :

F:\Maison\Armoire\Tiroir
F:\Maison\Armoire\Tiroir 2\Classeur
F:\Maison\Armoire\Tiroir 2
F:\Maison\Armoire
F:\Maison\Commode
F:\Maison

Cette macro, plus complète, permet de lister les dossiers, les fichiers, et les fichiers avec leur chemin complet :

Sub ListingFichierDossier()
    Dim MaRecherche As New Recherche
    MaRecherche.Analyse "F:\Maison"
    
    Debug.Print "--- Liste des dossiers : ---"
    For Ctr = 1 To MaRecherche.ListeDossier.Count
        Debug.Print MaRecherche.ListeDossier(Ctr)
    Next
    
    Debug.Print "----------------------------"
    Debug.Print "--- Liste des fichiers : ---"
    For Ctr = 1 To MaRecherche.ListeFichier.Count
        Debug.Print MaRecherche.ListeFichier(Ctr)
    Next
    
    Debug.Print "------------------------------------------------------"
    Debug.Print "--- Liste des fichiers, avec leur chemin complet : ---"
    ' On aurait pu indifféremment compter de 1 a ListeDossierFichier.Count : 
    For Ctr = 1 To MaRecherche.ListeFichier.Count
        Debug.Print MaRecherche.ListeDossierFichier(Ctr)
    Next
    
    Set MaRecherche = Nothing
End Sub

Qui donne :

--- Liste des dossiers : ---
F:\Maison\Armoire\Tiroir
F:\Maison\Armoire\Tiroir 2\Classeur
F:\Maison\Armoire\Tiroir 2
F:\Maison\Armoire
F:\Maison\Commode
F:\Maison
----------------------------
--- Liste des fichiers : ---
Choses à penser.txt
Logo.gif
Photo de vacances.gif
fichiertest2.txt
Liste de commissions.txt
Portrait.gif
Belle photo.gif
CommandePereNoel.txt
------------------------------------------------------
--- Liste des fichiers, avec leur chemin complet : ---
F:\Maison\Armoire\Tiroir\Choses à penser.txt
F:\Maison\Armoire\Tiroir\Logo.gif
F:\Maison\Armoire\Tiroir 2\Classeur\Photo de vacances.gif
F:\Maison\Armoire\fichiertest2.txt
F:\Maison\Armoire\Liste de commissions.txt
F:\Maison\Armoire\Portrait.gif
F:\Maison\Belle photo.gif
F:\Maison\CommandePereNoel.txt

Recherche d'un type de fichier

Nous disposons ainsi de trois listes qui vont nous être très précieuses pour rechercher tel ou tel fichier. Par exemple, voici le code pour afficher toutes les images, quel que soit leur dossier dans lequel elles sont :

Sub RechercheImage()
    Dim MaRecherche As New Recherche
    MaRecherche.Analyse "F:\Maison"
    For Ctr = 1 To MaRecherche.ListeFichier.Count
        If Right(MaRecherche.ListeFichier(Ctr), 3) = "jpg" Or Right(MaRecherche.ListeFichier(Ctr), 3) = "gif" Then
           Debug.Print MaRecherche.ListeFichier(Ctr)
        End If
    Next
    Set MaRecherche = Nothing
End Sub

Nous pouvons utiliser le With, afin de raccourcir l'écriture :

Sub RechercheImage()
  Dim MaRecherche As New Recherche
  With MaRecherche
    .Analyse "F:\Maison"
    For Ctr = 1 To .ListeFichier.Count
      If Right(.ListeFichier(Ctr), 3) = "jpg" Or Right(.ListeFichier(Ctr), 3) = "gif" Then
         Debug.Print .ListeFichier(Ctr)
      End If
    Next
  End With
  Set MaRecherche = Nothing
End Sub

Voici le résultat (Je n'ai que des .gif, et pas de .jpg dans mes dossiers) :

Logo.gif
Photo de vacances.gif
Portrait.gif
Belle photo.gif

Effacement de tous les fichiers d'un certain type

Si j'avais voulu les effacer plutot que de les afficher :

Sub SupprimerImage()
    Dim MaRecherche As New Recherche
    With MaRecherche
        .Analyse "F:\Maison"
        For Ctr = 1 To .ListeFichier.Count
     If Right(.ListeFichier(Ctr), 3) = "jpg" Or Right(.ListeFichier(Ctr), 3) = "gif" Then
        ' Voici l'utilité de ListeFichierDossier : on efface le fichier qui se trouve
        ' dans le chemin d'accès (sinon, il ne le trouvera simplement pas):       
        Kill .ListeDossierFichier(Ctr)
        Kill .ListeFichier(Ctr)
     End If
        Next
    End With
    Set MaRecherche = Nothing
End Sub

Affichage/effacement de tous les dossiers vides

Sub AfficherDossierVide()
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim Dossier As Folder
    Dim MaRecherche As New Recherche
    With MaRecherche
        .Analyse "F:\Maison"
        For Ctr = 1 To .ListeDossier.Count
            ' S'il y a 0 Fichiers ET 0 dossiers, alors, OK, le dossier est vide :
            If (GestionFichier.GetFolder(.ListeDossier(Ctr)).Files.Count = 0) And _
(GestionFichier.GetFolder(.ListeDossier(Ctr)).SubFolders.Count = 0) Then
Debug.Print .ListeDossier(Ctr) & " Est vide" End If Next End With Set MaRecherche = Nothing Set GestionFichier = Nothing Set Dossier = Nothing End Sub

Il n'y a qu'un dossier qui correspond (Complètement vide) : F:\Maison\Commode

Si maintenant je ne me contente pas d'afficher les dossiers vides, mais que je désire carrément les effacer, il suffit d'ajouter la ligne suivante :

If (GestionFichier.GetFolder(.ListeDossier(Ctr)).Files.Count = 0) And _
   (GestionFichier.GetFolder(.ListeDossier(Ctr)).SubFolders.Count = 0) Then
   Debug.Print .ListeDossier(Ctr) & " Est vide"
   RmDir .ListeDossier(Ctr)
End If

Mais ce n'est pas si simple ! Il y a un truc un peu tordu ! En effet, imaginez que vous demandiez à effacer tous les dossiers vide du dossier F:\Truc. Mais si F:\Truc ne contient aucun fichier mais contient un sous-dossier Machin, et que ce dossier Machin ne contient aucun fichier, mais contient lui-même un sous-dossier Bidule (On a donc F:\Truc\Machin\Bidule), mais on n'a aucun fichier.

D'après notre logique, seul Bidule sera effacé, puisque Truc contient Machin, et Machin contient Bidule, vous suivez ?

Du coup, après traitement, nous allons nous retrouver avec F:\Truc et F:\Truc\Machin ! Il faudra relancer une 2ème fois la macro pour se débarasser de Machin !

En fait, tant qu'il trouve des dossiers vides, il faut relancer la macro ! Voici comment le faire automatiquement :

Sub EffacerDossierVide()
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim Dossier As Folder
    Dim MaRecherche As New Recherche
    ' Je déclare une variable qui va contenit true (vrai) ou false (Faux)
    Dim DossierVideTrouve As Boolean
    DossierVideTrouve = True ' Et jel'initialise à Vrai (True)
    ' Tant que DossierVideTrouve est à True (Elle l'est forcément, je viens de la mettre à true !)
    ' ET QUE le dossier F:\Truc Existe (Oui, c'est une condition minimum... Et dans notre cas, comme c'est
    ' Truc qui ne contient que Machin qui ne contient que Bidule, tout va être effacé, y crompris Truc
    While DossierVideTrouve = True And GestionFichier.FolderExists("F:\Truc")
        ' Hop ! Je mets immédiatement DossierVideTrouve à False ! 
        DossierVideTrouve = False
        With MaRecherche
            .Analyse "F:\Truc"
            ' Allons-y ! Parcourons les dossiers !
            For Ctr = 1 To .ListeDossier.Count
                ' Y'a ni fichier, ni dossier dans le dossier courant ? 
                If (GestionFichier.GetFolder(.ListeDossier(Ctr)).Files.Count = 0) And _
                (GestionFichier.GetFolder(.ListeDossier(Ctr)).SubFolders.Count = 0) Then
                   Debug.Print .ListeDossier(Ctr) & "Est vide"
                   ' OK, ben on efface le dossier alors !
                   RmDir .ListeDossier(Ctr)
                   ' Du coup, comme on a trouvé un dossier vide, on va devoir recommencer toute
                   ' l'analyse parce que, du coup, son dossier parent était peut-être vide aussi !
                   ' Je met donc DossierVideTrouve à True :
                   DossierVideTrouve = True
                End If
            Next
            ' marecherche doit être complètement vidée, car on va re-remplir ListeDossier :
            Set MaRecherche = Nothing
        End With
    ' Maintenant, on va remonter au début du While... Si DossierVideTrouve = True...
    ' Là, il l'est, on l'a vu juste un peu plus haut
    Wend
    Set GestionFichier = Nothing
    Set Dossier = Nothing
End Sub

Exercice complet

Pour clôturer ce didacticiel, je vous propose un exercice complet (que vous pourrez télécharger ici).

Je vous propose de télécharger exercice.zip. Il contient une hiérarchie de dossiers, dans lesquels il y a notamment des fichiers .txt.

Admettons que vous désirez tous les imprimer, et que les imprimer un par un est une tâche fastidieuse... S'il y en avait plusieurs centaines, ce serait vraiment très inconfortable.

Vous allez donc tous les ouvrir, et copier leur contenu, l'un en dessous de l'autre, dans un seul gros fichier .txt (Dans le but de facilement les consulter).

Ensuite, nous renommerons tous ces fichiers en ajoutant le mot "Obsolète" devant chacun d'entre eux. par exemple : Mémo 2012.txt deviendra "Obsolète Mémo 2012.txt".

Ensuite, en plus de les renommer, nous les enverrons à la corbeille.

Et,en dernier lieu, nous ouvrirons le fichier récapitulatif avec le Bloc-Notes (Notepad)... Vous pourrez alors facilement le lire, l'imprimer, ou l'envoyer par e-mail, mais l'exercice s'arrête là.

Le code complet est à la fin de cette page.

Marche à suivre résumée

  1. [Voir détail] A l'aide d'une DialogBox, nous allons demander à l'utilisateur de sélectionner le dossier désiré (Ce sera donc Documents d'Entreprise), que vous aurez dézippé à un certain endroit de votre disque dur
  2. [Voir détail] Nous allons demander à l'utilisateur quel nom de fichier récapitulatif il désire (On lui proposera le nom par défaut Récap.txt, et on lui proposera de le créer et de le poser sur le bureau, par défaut.
  3. [Voir détail] Nous allons utiliser le module de classe Recherche afin de trouver tous les fichiers txt de tous les dossiers
  4. [Voir détail] Nous allons alors créer physiquement le fichier Recap.txt, et nous allons parcourir tous les fichiers txt trouvés, et, pour chacun d'eux, nous écrivons, dans le fichier récapuitulatif :
    - Une série de petits traits : --------------------
    - Le texte : "Dossier :", suivi du nom du dossier dans lequel le fichier se trouve
    - Le texte "Fichier :", suivi du nom du fichier txt que nous sommes en train de lire
    - Une autre série de petits traits : -------------------
    - Le contenu du fichier qu'on est en train de lire
    - Une ligne vide
  5. [Voir détail] On renomme chacun des fichiers en "Obsolète " suivi du nom du fichier
  6. [Voir détail] On l'envoie à la corbeille grâce aux API que nous avons vu.
  7. [Voir détail] On ouvre finalement le fichier récapitulatif avec le bloc notes

Demande du dossier à analyser

Nous allons utiliser FileDialog(msoFileDialogFolderPicker), comme nous l'avons vu ici :

Sub Exercice()
    Application.FileDialog(msoFileDialogFolderPicker).Show
    MsgBox Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End Sub

Lorsque l'utilisateur a sélectionné un dossier, son chemin complet s'affiche :

Gestion de l'annulation

Si l'utilisateur clique sur Annuler, il faut le gérer, comme on l'a vu ici.

Ici, si l'utilisateur clique sur Annuler, il faut simplement sortir (Exit Sub), on ne va pas plus loin.. Et si un dossier est sélectionné, eh bien, le If est simplement ignoré, et on affiche le dossier avec MsgBox :

Sub Exercice()
    If Application.FileDialog(msoFileDialogFolderPicker).Show = False Then
       Exit Sub
    End If
    MsgBox Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End Sub

Personnalisation de la boîte de dialogue

Nous allons mettre un titre à la boîte de dialogue, et renommer le bouton de validation du dossier :

Sub Exercice()
    Application.FileDialog(msoFileDialogFolderPicker).ButtonName = "Analyse ce dossier"
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du dossier à analyser"
    If Application.FileDialog(msoFileDialogFolderPicker).Show = False Then
       Exit Sub
    End If
    MsgBox Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End Sub

Utilisons un With - End With pour simplifier cette écriture, comme nous l'avons vu ici :

Sub Exercice()
    With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Analyse ce dossier"
         .Title = "Choix du dossier à analyser"
         If .Show = False Then
            Exit Sub
         End If
         MsgBox .SelectedItems(1)
    End With
End Sub

Plutôt que d'afficher bêtement ce dossier, nous allons le transférer dans une variable. Nous en aurons besoin par la suite :

Sub Exercice()
    With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Analyse ce dossier"
         .Title = "Choix du dossier à analyser"
         If .Show = False Then
            Exit Sub
         End If
         DossierAnalyse = .SelectedItems(1)
    End With
End Sub

Dans le but de travailler proprement, même si ce n'est pas obligatoire, nous allons rendre la déclaration des variables obligatoires, et déclarer DossierAnalyse, comme ceci :

Option Explicit
Sub Exercice()
    Dim DossierAnalyse
    With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Analyse ce dossier"
         ...
End Sub

Détermination du fichier récapitulatif

Maintenant, nous allons demander à l'utilisateur dans quel fichier, et où, il veut son fichier récapitulatif. Je n'utilise pas msoFileDialogFilePicker car, comme je l'ai mentionné, je ne peux pas spécifier un nom de fichier inexistant.

Sub Exercice()
    Dim DossierAnalyse
    With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Analyse ce dossier"
         .Title = "Choix du dossier à  analyser"
         If .Show = False Then
            Exit Sub
         End If
         DossierAnalyse = .SelectedItems(1)
    End With
    
    MsgBox Application.FileDialog(msoFileDialogSaveAs).Show
End Sub

Tout comme pour le choix du dossier, nous allons tester si l'utilisateur n'a pas appuyé sur Annuler, et nous allons transférer le fichier choisi dans une variable :

Sub Exercice()
    Dim DossierAnalyse, FichierRecapitulatif
    ...
         DossierAnalyse = .SelectedItems(1)
    End With
    If Application.FileDialog(msoFileDialogSaveAs).Show = False Then
       Exit Sub
    End If
    FichierRecapitulatif = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
    MsgBox FichierRecapitulatif
End Sub

Maintenant, si vous testez la macro, Lorsque vous allez écrire un fichier, même si vous ne spécifiez pas l'extension, si vous êtes dans Excel, comme le filtre est réglé sur .xlsx, le fichier va se terminer par .xlsx, même si vous avez spécifié une finale en .txt :

Pourquoi ne pas utiliser FilterIndex, comme je l'ai expliqué ici ? On voit que les fichiers textes sont à la 11ème position :

Parce que dans Excel 2010, le texte est à la 11ème position ! Mais dans Word, ou une ancienne version d'Excel, ce .txt n'est pas à la 11ème position ! Eh oui !

Du coup, nous allons devoir feinter !

Nous allons remplacer .xlsx (Si on est dans Excel), ou le .docx (Si on est dans Word), ou même .xls (si on est dans Excel 2003) par le même fichier, mais en .txt.

Ici, on déborde un peu du sujet des fichiers, mais, en gros, nous allons rechercher la position du point grâce à InStr (In string), et une fois qu'on a la position du point (qui peut être 4 ou 5 caractères avant la fin du nom du fichier, selon le nombre de lettres de l'extension), on demande la partie gauche (Left) du nombre de caractères jusqu'au point, et on lui colle "txt" avec & "txt", comme ceci (Ne vous inquiétez pas si ça vous parait obscur, l'important est que l'on arrive bien à avoir un fichier.txt :

Sub Exercice()
    Dim DossierAnalyse, FichierRecapitulatif
    With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Analyse ce dossier"
         .Title = "Choix du dossier à  analyser"
         If .Show = False Then
            Exit Sub
         End If
         DossierAnalyse = .SelectedItems(1)
    End With
    If Application.FileDialog(msoFileDialogSaveAs).Show = False Then
       Exit Sub
    End If
    ' Si vous écrivez "Recap", FichierRecapitulatif sera égal à : Recap.xlsx
    FichierRecapitulatif = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
    ' Grâce à la ligne suivante, Recap.xlsx sera égal à Recap.txt :
    ' (Dans le cas "Recap.xlsx", InStr(1, FichierRecapitulatif, ".") égale 6 (6ème position))
    '(C'est un peu comme si on avait écrit Left(FichierRecapitulatif, 6)
    '(partie Gauche, 6 caractères & "txt")
    FichierRecapitulatif = Left(FichierRecapitulatif, InStr(1, FichierRecapitulatif, ".")) & "txt"
    MsgBox FichierRecapitulatif
End Sub

Petite faiblesse : la boîte de dialogue affiche toujours le filtre Excel : . Bon, on ne va pas pinailler... Il n'y a pas de manière simple de faire disparaître ça, tant pis, c'est pas très grave...

Nous allons personnaliser la boîte de dialogue (Titre et bouton, et nous en profitons pour réduire la syntaxe avec un With :

Sub Exercice()
    Dim DossierAnalyse, FichierRecapitulatif
    ...
    With Application.FileDialog(msoFileDialogSaveAs)
        .ButtonName = "Créer, et lancer l'analyse"
        .Title = "Création du fichier de récapitulation"
        .InitialFileName = "Récap"
        If .Show = False Then
           Exit Sub
        End If
        FichierRecapitulatif = .SelectedItems(1)
        FichierRecapitulatif = Left(FichierRecapitulatif, InStr(1, FichierRecapitulatif, ".")) & "txt"
    End With
    MsgBox FichierRecapitulatif
End Sub

Oups ! Le truc gênant, c'est que .InitialFileName ajoute automatiquement .xlsx à Récap !

Techniquement, ce n'est pas gênant, puisque de toute façon on va le remplacer comme on a vu plus haut... Par contre, l'utilisateur ne va rien comprendre, et va croire à un bug !

Là, nous sommes un peu désarmés ! Heureusement qu'il nous reste une arme ! SendKeys. SendKeys est une instruction qui simule des frappes de clavier, exactement comme si vous écriviez vous-même ! Ainsi, plutôt qu'utiliser .InitialFileName qui nous fait des blagues, nous allons écrire SendKeys "Recap". Ce sera exactement comme si vous écriviez à la main R, é, c, a, p :

...
.Title = "Création du fichier de récapitulation"
SendKeys "Récap"
.InitialFileName = "Récap"
If .Show = False Then
   ...     

Pensez à structurer et commenter votre code, comme ceci :

Option Explicit
Sub Exercice()
    ' Déclaration des variables :
    Dim DossierAnalyse ' dossier à analyser
    Dim FichierRecapitulatif ' chemin + fichier de récapitulation.txt
    
     ' Sélection du dossier à analyser :
    With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Analyse ce dossier"
         .Title = "Choix du dossier à  analyser"
         If .Show = False Then ' Si l'utilisateur clique sur Annuler
            Exit Sub
         End If
         DossierAnalyse = .SelectedItems(1)
    End With
    
     ' Choix du fichier de récapitulation :
    With Application.FileDialog(msoFileDialogSaveAs)
        .ButtonName = "Créer, et lancer l'analyse"
        .Title = "Création du fichier de récapitulation"
        SendKeys "Récap"  ' InitialFileName nous ajouterait .xlsx à la fin du fichier
        If .Show = False Then  ' Si l'utilisateur clique sur Annuler
           Exit Sub
        End If
        FichierRecapitulatif = .SelectedItems(1)
        ' On enlève l'extension par défaut, et on la remplace par txt :
        FichierRecapitulatif = Left(FichierRecapitulatif, InStr(1, FichierRecapitulatif, ".")) & "txt"
    End With
End Sub

Nous allons quand même revenir à ce .InitialFileName, parce que dans l'énoncé de l'exercice, il a été demandé que, par défaut, le fichier de récapitulation devait être proposé sur le bureau. Le bureau (DeskTop) est un dossier spécial que nous avons vu ici. Vous allez donc devoir copier ceci au dessus de votre macro :

Private Declare Function _
SHGetSpecialFolderPath Lib "shell32.dll" Alias _
"SHGetSpecialFolderPathA" _
(ByVal hwndOwner As Long, ByVal lpszPath As String, _
ByVal nFolder As Long, ByVal fCreate As Long) As Long

Public Function DossierSpecial(ReferenceDossier As Long)
    Dim CheminAcces As String
    CheminAcces = Space(256)
    SHGetSpecialFolderPath hwnd, CheminAcces, ReferenceDossier, 0
    DossierSpecial = Left(CheminAcces, InStr(CheminAcces, Chr(0)) - 1)
End Function

Sub Exercice()
    ...
    ...
End Sub

Afin de connaître le numéro de référence du dossier Desktop, vous allez devoir faire tourner la macro ListeDossierSpeciaux(). Je le fais pour vous : Je trouve le 16.

...
13 : C:\Users\MichelD\Music
14 : C:\Users\MichelD\Videos
16 : C:\Users\MichelD\Desktop
19 : C:\Users\MichelD\AppData\Roaming\Microsoft\Windows\Network Shortcuts
20 : C:\Windows\Fonts ...

Nous allons donc maintenant utiliser la fonction DossierSpecial(16) et l'injecter dans InitialFileName :

...
With Application.FileDialog(msoFileDialogSaveAs)
     .ButtonName = "Créer, et lancer l'analyse"
     .Title = "Création du fichier de récapitulation"
     .InitialFileName = DossierSpecial(16)
     SendKeys "Récap"
     If .Show = False Then ' Si l'utilisateur clique sur Annuler
        Exit Sub
     End If
...     

Mais malheureusement, ça ne fonctionne pas exactement comme on veut ! Il croit que "Desktop" est le nom du fichier qu'on veut sauver, alors que c'est simplement le nom du dossier du bureau !

Tout ça à cause de FileDialog(msoFileDialogSaveAs) ! Parce qu'avec FileDialog(msoFileDialogFilePicker), il aurait correctement sélectionné le dossier, comme nous l'avons vu !

Du coup, on va lui rajouter artificiellement du texte, comme ceci

.InitialFileName = DossierSpecial(16) & "/NimporteQuoi""

Ce qui fait que, du coup, il va aller dans le bon dossier du bureau, et proposer comme fichier : NimporteQuoi.xlsx

Et, nous allons lui clouer le bec avec notre SendKeys "Récap" qui va remplacer cette proposition idiote "NimporteQuoi.xlsx

Vous suivez toujours ?


...
.Title = "Création du fichier de récapitulation"
.InitialFileName = DossierSpecial(16) & "\Nimportequoi"
SendKeys "Récap"
If .Show = False Then ' Si l'utilisateur clique sur Annuler
...

il faut bien avouer que 16, ce n'est pas très parlant ! Afin de rendre notre code plus lisible, nous allons déclarer une constante et l'utiliser. C'est à dire que nous allons décider, au début du programme, que 16 sera stocké dans une "variable" appelée Bureau, comme ceci :

Sub Exercice()
    ' Déclaration des variables :
    Dim DossierAnalyse ' Contient le dossier à analyser
    Dim FichierRecapitulatif ' Contient le chemin et le fichier de récapitulation
    Const Bureau = 16 ' Code de l'emplacement du bureau de l'utilisateur courant
    ...
    With Application.FileDialog(msoFileDialogSaveAs)
        .ButtonName = "Créer, et lancer l'analyse"
        .Title = "Création du fichier de récapitulation"
        .InitialFileName = DossierSpecial(Bureau) & "\NimporteQuoi"
        SendKeys "Récap" ' InitialFileName nous ajouterait .xlsx à la fin du fichier
End Sub

Petit bug : Si vous lancez plusieurs fois la macro, le InitialFileName va être mémorisé, et la fois suivante que vous allez lancer la macro, NimporteQuoi va être affiché dans la première boîte de dialogue du choix de dossier :

Afin d'éviter ce phénomène, on peut mettre l'InitialFileName à vide ("") dans la première boîte de dialogue :

...
With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Analyse ce dossier"
         .Title = "Choix du dossier à  analyser"
         .InitialFileName = ""
         If .Show = False Then

Récupération de tous les fichiers .txt de tous les dossiers et sous-dossiers

Maintenant que nous avons stocké le chemin d'accès du dossier à analyser dans DossierAnalyse et le chemin d'accès + le nom du fichier récapitilatif dans FichierRecapitulatif, il nous reste à récupérer l'ensemble de tous les fichiers .txt du dossier principal, mais aussi de tous les sous dossiers. Nous allons donc devoir être en possession de notre module de classe fait maison : Recherche. Il s'agit maintenant de l'utiliser, comme nous l'avons vu ici.

Sub Exercice()
   ' Déclaration des variables :
    ' Sélection du dossier à analyser :
    With Application.FileDialog(msoFileDialogFolderPicker)
         ...
    End With
    ' Choix du fichier de récapitulation :
    With Application.FileDialog(msoFileDialogSaveAs)
       ...
    End With
    Dim ToutFichierTXT As New Recherche
    ToutFichierTXT.Analyse DossierAnalyse
    Set ToutFichierTXT = Nothing
End Sub

J'ai préféré créer une variable objet ToutFichierTXT plutôt que MaRecherche de l'exemple du didacticiel, car ça me paraissait plus parlant.

On va quand même vérifier ! Normalement, il devrait trouver 4 dossiers et 6 fichiers (dont 2 images, certes !)

...
Dim ToutFichierTXT As New Recherche
ToutFichierTXT.Analyse DossierAnalyse
Debug.Print ToutFichierTXT.ListeDossier.Count & " dossiers"
Debug.Print ToutFichierTXT.ListeFichier.Count & " fichiers"
Set ToutFichierTXT = Nothing
End Sub

Donne effectivement :

4 dossiers
6 fichiers

Parcours des fichiers .txt

Maintenant, il s'agit de parcourir tous les fichiers .txt, comme nous l'avons vu ici.

Sub Exercice()
   ...
    ... 
    ...
    End With
    Dim ToutFichierTXT As New Recherche
    ToutFichierTXT.Analyse DossierAnalyse
    ' On boucle de 1 jusqu'au nombre de fichiers trouvés
    For Compteur = 1 To ToutFichierTXT.ListeFichier.Count
        ' Si le fichier actuel se termine par .txt...        
        If Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then
           ' ... on l'affiche !
           Debug.Print ToutFichierTXT.ListeDossierFichier(Compteur)
        End If
    Next
    Set ToutFichierTXT = Nothing
End Sub

Ca fonctionne. Voici tous les fichiers texte :

F:\Atelier\Documents d'entreprise\Archives\Règlement interne.txt
F:\Atelier\Documents d'entreprise\Ventes prévues\Liste des prix.txt
F:\Atelier\Documents d'entreprise\Conditions.txt
F:\Atelier\Documents d'entreprise\Liste des clients.txt

Maintenant, on ne veut pas simplement les afficher ! On veut copier leur contenu dans le fichier de récapitulation.

Tout ce code va s'exécuter à cet endroit :

For Compteur = 1 To ToutFichierTXT.ListeFichier.Count
    If Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then
       ' ICI ! ... la copie va ainsi se faire pour chaque fichier
    End If
Next

Pour vous rafraîchir la mémoire, voici comment on écrit dans un nouveau fichier texte, et voici comment on ajoute de nouvelles choses à un fichier existant.

Création du fichier de récapitulation

Ainsi, pour le premier fichier texte a copier, il faudrait créer le fichier de récapitulation, et, pour tous les autres, il faudrait ajouter de nouvelles lignes. Pour  éviter cette exception du premier fichier, je propose que nous créions le fichier de récapitulation (qui s'appelle Récap.txt si vous acceptez la proposition par défaut), que nous le fermions immédiatement, et que nous le rouvrions en ajout (ForAppending) dès la copie du contenu du premier fichier :

Sub Exercice()
    ...
    End With
    
    ' J'ai besoin de ceci pour pouvoir utiliser CreateTextFile :
    Dim GestionFichier As New Scripting.FileSystemObject
Ne confondez pas la variable-objet FichRecap, qui représente un objet de type TextStream (c'est cette variable qui nous permettra d'écrire dans le fichier), et FichierRecapitulatif, qui n'est qu'une simple chaîne de caractère qui contient le chemin et le nom du fichier de récapitulation (C:\Users\MarcelDurand\Desktop\Récap.txt par exemple)
Dim FichRecap As Scripting.TextStream ' Création effective (Sans doute sur votre bureau si vous avez accepté la proposition) Set FichRecap = GestionFichier.CreateTextFile(FichierRecapitulatif) ' On n'écrit rien, on se contente de l'avoir créé... ' on ferme ce fichier créé, mais vide FichRecap.Close Set GestionFichier = Nothing Dim ToutFichierTXT As New Recherche ToutFichierTXT.Analyse DossierAnalyse Set GestionFichier = Nothing For Compteur = 1 To ToutFichierTXT.ListeFichier.Count If Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then ' ICI, on mettra les instructions pour ajouter le contenu des autres fichiers ' dans le fichier de récapitulation End If Next Set ToutFichierTXT = Nothing End Sub

Si vous exécutez cette macro, vous devriez voir apparaître quelque part sur votre bureau Windows, un fichier nommé Récap.txt, qui, si vous l'ouvrez, ne contient rien:

Si vous exécutez la macro plusieurs fois de suite, le fichier de récapitulation sera à chaque fois écrasé. Prenons le parti de ne pas avertir l'utilisateur de l'écrasement éventuel, afin de ne pas trop alourdir cette macro déjà bien complexe.

Maintenant, il s'agit de récupérer le contenu de tous les fichiers .txt, et de les transférer dans le fichier de récapitulation.

Rappelez-vous : j'explique ici comment on fait pour ajouter du contenu dans un fichier existant, et ici pour vous rappeler comment faire pour lire.

On commence :

' Création simple du fichier de récapitulation :
Dim GestionFichier As New Scripting.FileSystemObject
Dim FichRecap As Scripting.TextStream
Set FichRecap = GestionFichier.CreateTextFile(FichierRecapitulatif)
' On n'écrit rien, on se contente de l'avoir créé...
FichRecap.Close
' Comme on va avoir besoin de de GestionFichier pour ouvrir les TextStream dans la boucle,
' Il ne faut pas le libérer maintenant, mais tout à la fin  :
Set GestionFichier = Nothing
Dim ToutFichierTXT As New Recherche
ToutFichierTXT.Analyse DossierAnalyse
For Compteur = 1 To ToutFichierTXT.ListeFichier.Count
    If Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then
       ' Je déclare à nouveau une variable objet pour lire les fichiers :
       Dim FichierACopier As Scripting.TextStream
       ' ICI, les instructions pour ajouter le contenu des autres fichiers
       Set FichierACopier = GestionFichier.OpenTextFile("Fichier Actuel", ForReading)
       FichierACopier.Close
    End If
Next
Set ToutFichierTXT = Nothing
Set GestionFichier = Nothing

Concentrons-nous sur la ligne d'ouverture du fichier :

Set FichierACopier = GestionFichier.OpenTextFile("Fichier Actuel", ForReading)

Qu'est le fichier actuel ? C'est le chemin d'accès et le nom du fichier parcouru dans le compteur. Comme ceci :

Constatez que le Compteur compte ListeFichier et pas ListeFichierDossier, mais il aurait pu tout aussi bien compter les ListeFichierDossier (Ils contiennent le même nombre d'éléments - La seule différence est que ListeFichierDossier contient aussi le chemin d'accès)

    For Compteur = 1 To ToutFichierTXT.ListeFichier.Count
        If Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then
           Dim FichierACopier As Scripting.TextStream
Set FichierACopier = GestionFichier.OpenTextFile(ToutFichierTXT.ListeDossierFichier(Compteur), ForReading)
           MsgBox FichierACopier.ReadAll
           ' ICI, les instructions pour ajouter le contenu des autres fichiers
           FichierACopier.Close
        End If
    Next

Maintenant, essayons d'afficher le contenu de chaque fichier, grâce à ReadAll :

Dim FichierACopier As Scripting.TextStream
Set FichierACopier = GestionFichier.OpenTextFile(ToutFichierTXT.ListeDossierFichier(Compteur), ForReading)
Debug.Print FichierACopier.ReadAll
FichierACopier.Close

Ca marche fort bien ! Voici le contenu de tous les fichiers cumulés :

Art. 1 - Subdivision des succursales
Les subdivisions des succursales en unités scientifiques et en unités administratives sont réglées par les règlements des Facultés.
Art. 2 - Unités facultatives
Certaines unités peuvent être facultatives.
Boite de mouchoirs, CHF 1.20
Pince à linge, CHF 0.15
Tassa à café, CHF 3.95
1. Pour utilier le service proposé, le client doit préalablement s'inscrire en ligne. 
2. Lors de la procédure d'inscription, le client doit expressément accepter les présentes conditions générales en cliquant sur le bouton y relatif.
André BRASSARD, Né le 3.8.1976
Bernard BARBUSSE, Né le 14.9.1942
Charles BILDER, Né le 19.9.1986

Ce n'est pas suffisant. Il faut rajouter :

Comme ceci :

Il s'agit donc d'ajouter ces lignes :

For Compteur = 1 To ToutFichierTXT.ListeFichier.Count
   If Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then
      Dim FichierACopier As Scripting.TextStream
      Set FichierACopier = GestionFichier.OpenTextFile(ToutFichierTXT.ListeDossierFichier(Compteur), ForReading)
      Debug.Print "-------------------------"
      Debug.Print ToutFichierTXT.ListeDossier(Compteur)
      Debug.Print "Fichier : " & ToutFichierTXT.ListeFichier(Compteur)
      Debug.Print "-------------------------"
      Debug.Print FichierACopier.ReadAll
      Debug.Print ""
      FichierACopier.Close
   End If
Next

Mais pourquoi ai-je barré l'affichage du dossier ToutFichierTXT.ListeDossierFichier(Compteur) ?

Parce qu'il s'agit d'un compteur qui va compter tous les fichiers de tous les dossiers et sous-dossiers !

En gros, la liste des dossiers contient (Peut-être pas dans le même ordre numérique) :

Tandis que ListeFichier et ListeFichierDossier contiennent bien plus d'éléments:

On ne peut donc pas utiliser ListeDossier, mais on doit extraire le chemin d'accès (mais sans le nom du fichier) de DossierFichier.

Il faut faire preuve d'astuce : Nous allons récupérer le nombre de caractères de ToutFichierTXT.listeFichier, et, une fois qu'on a ce renseignement, on va extraire la partie gauche de ToutFichierTXT.ListeDossierFichier. De combien de caractères ? Eh bien de la longueur de ToutFichierTXT.ListeDossierFichier - la longueur de ToutFichierTXT.listeFichier.

La fonction qui calcule la longueur d'un texte s'appelle Len (Length = Longueur), et pour extraire la partie gauche, c'est Left. Pa rexemple, Debug.Print Left("abcde",3) afficherait abc.

Remplacez donc :

Debug.Print "-------------------------"
Debug.Print "Dossier : " & Left(ToutFichierTXT.ListeDossierFichier(Compteur), _
Debug.Print ToutFichierTXT.ListeDossier(Compteur)
Debug.Print "Fichier : " & ToutFichierTXT.ListeFichier(Compteur)
Debug.Print "-------------------------"

Par ceci (L'instruction est si longue que j'ai dû me résoudre à la scinder sur 3 lignes, avec des traits de soulignement à la fin qui me permettent une telle chose) :

Debug.Print "-------------------------"
Debug.Print "Dossier : " & Left(ToutFichierTXT.ListeDossierFichier(Compteur), _
Debug.Print "Dossier : " & Left(ToutFichierTXT.ListeDossierFichier(Compteur), _
            Len(ToutFichierTXT.ListeDossierFichier(Compteur)) - _
            Len(ToutFichierTXT.ListeFichier(Compteur)))       
Debug.Print "Fichier : " & ToutFichierTXT.ListeFichier(Compteur)
Debug.Print "-------------------------"

Le résultat est convaincant :

Bien. Ceci dit, il ne s'agit pas d'afficher ces contenus, mais de les transférer dans le fichier de récapitulation (Comme ceci) !

Avant ça, nous allons faire une petite correction : Il ne sert à rien de définir la variable objet FichierACopier dans la boucle For. Une fois suffit, autant le mettre avant. Ca ne va pas changer la face du monde, mais autaant faire les choses dans les règles.


...
' Création simple du fichier de récapitulation :
Dim GestionFichier As New Scripting.FileSystemObject
Dim FichRecap As Scripting.TextStream
Dim FichierACopier As Scripting.TextStream
Set FichRecap = GestionFichier.CreateTextFile(FichierRecapitulatif)
' On n'écrit rien, on se contente de l'avoir créé...
FichRecap.Close
Set GestionFichier = Nothing
Dim ToutFichierTXT As New Recherche
ToutFichierTXT.Analyse DossierAnalyse
For Compteur = 1 To ToutFichierTXT.ListeFichier.Count
    If Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then
       Dim FichierACopier As Scripting.TextStream
       FichierACopier = GestionFichier.OpenTextFile(ToutFichierTXT.ListeDossierFichier(Compteur), ForReading)
       Debug.Print "-------------------------"
       ...

Maintenant, dans le but d'ajouter les nouveaux contenus à notre fichier de récapitulation, nous allons réutiliser la variable FichRecap, que nous avions déjà utilisée pour la création du fichier, comme ceci :

...
Dim FichRecap As Scripting.TextStream
Dim FichierACopier As Scripting.TextStream
Set FichRecap = GestionFichier.CreateTextFile(FichierRecapitulatif)
' On n'écrit rien, on se contente de l'avoir créé...
' On le ferme pour mieux le rouvrir en mode ajout (ForAppending) un peu plus bas :
FichRecap.Close
Dim ToutFichierTXT As New Recherche
ToutFichierTXT.Analyse DossierAnalyse
' On ouvre le fichier de récapitulation en mode ajout juste avant la boucle for, car
' contrairement à tous les fichiers à analyser qu'il faut ouvrir et fermer à chaque tour
' de boucle, FichRecap s'ouvre une fois pour toute juste avant, et se ferme après :
Set FichRecap = GestionFichier.OpenTextFile(FichierRecapitulatif, ForAppending)
For Compteur = 1 To ToutFichierTXT.ListeFichier.Count
    If Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then
       Set FichierACopier = GestionFichier.OpenTextFile(ToutFichierTXT.ListeDossierFichier(Compteur), ForReading)
       Debug.Print "-------------------------"
       Debug.Print "Dossier : " & Left(ToutFichierTXT.ListeDossierFichier(Compteur), _
       Len(ToutFichierTXT.ListeDossierFichier(Compteur)) - _
       Len(ToutFichierTXT.ListeFichier(Compteur)))
           
       Debug.Print "Fichier : " & ToutFichierTXT.ListeFichier(Compteur)
       Debug.Print "-------------------------"
       Debug.Print FichierACopier.ReadAll
       Debug.Print ""
       FichierACopier.Close
    End If
Next
FichRecap.Close
Set ToutFichierTXT = Nothing
Set GestionFichier = Nothing

Et maintenant, la dernière étape de l'écriture consiste à remplacer les Debug.print :

Debug.Print "-------------------------"
Debug.Print "Dossier : " & Left(ToutFichierTXT.ListeDossierFichier(Compteur), _
Len(ToutFichierTXT.ListeDossierFichier(Compteur)) - _
Len(ToutFichierTXT.ListeFichier(Compteur)))
Debug.Print "Fichier : " & ToutFichierTXT.ListeFichier(Compteur)
Debug.Print "-------------------------"
Debug.Print FichierACopier.ReadAll
Debug.Print ""
FichRecap.WriteLine "-------------------------"
FichRecap.WriteLine "Dossier : " & Left(ToutFichierTXT.ListeDossierFichier(Compteur), _
Len(ToutFichierTXT.ListeDossierFichier(Compteur)) - _
Len(ToutFichierTXT.ListeFichier(Compteur)))
FichRecap.WriteLine "Fichier : " & ToutFichierTXT.ListeFichier(Compteur)
FichRecap.WriteLine "-------------------------"
FichRecap.WriteLine FichierACopier.ReadAll
FichRecap.WriteLine ""

Renommage des fichiers, en ajoutant "Obsolète" au début du fichier

Rappelez-vous comment renommer un fichier ici. Nous allons donc renommer tous les fichiers directement dans la boucle For, comme ceci :

For Compteur = 1 To ToutFichierTXT.ListeFichier.Count
    If Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then
       Set FichierACopier = GestionFichier.OpenTextFile(ToutFichierTXT.ListeDossierFichier(Compteur), ForReading)
       FichRecap.WriteLine "-------------------------"
       ' Rappelez-vous de cette ligne qui extrait le dossier, car nous allons en avoir
       ' à nouveau besoin pour le renommage :
       FichRecap.WriteLine "Dossier : " & Left(ToutFichierTXT.ListeDossierFichier(Compteur), _
       Len(ToutFichierTXT.ListeDossierFichier(Compteur)) - _
       Len(ToutFichierTXT.ListeFichier(Compteur)))
       FichRecap.WriteLine "Fichier : " & ToutFichierTXT.ListeFichier(Compteur)
       FichRecap.WriteLine "-------------------------"
       FichRecap.WriteLine FichierACopier.ReadAll
       FichRecap.WriteLine ""
       FichierACopier.Close
       ' On doit renommer le fichier en quoi ? en le même nom, mais avec 
       ' "Obsolète " au début du fichier.
       GestionFichier.MoveFile ToutFichierTXT.ListeDossierFichier(Compteur), ???
       ' C'est à dire que les ??? doivent en fait être : 
       ' le chemin d'accès du fichier & "Obsolète " & Le nom du fichier
       ' Et ca demande carrément tout ce qui est en bleu :
       GestionFichier.MoveFile ToutFichierTXT.ListeDossierFichier(Compteur), _
       Left(ToutFichierTXT.ListeDossierFichier(Compteur), _
       Len(ToutFichierTXT.ListeDossierFichier(Compteur)) - _
       Len(ToutFichierTXT.ListeFichier(Compteur))) & "Obsolète " & _
       ToutFichierTXT.ListeFichier(Compteur)
    End If
Next

Franchement, pour gagner en lisibilité, on aurait intérêt à stocker le chemin d'accès de chaque fichier dans une variable, et l'utiliser pour ces deux cas, comme ceci :

For Compteur = 1 To ToutFichierTXT.ListeFichier.Count
    If Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then
       Set FichierACopier = GestionFichier.OpenTextFile(ToutFichierTXT.ListeDossierFichier(Compteur), ForReading)
       FichRecap.WriteLine "-------------------------"
       Dim Chemin
       Chemin = Left(ToutFichierTXT.ListeDossierFichier(Compteur), _
       Len(ToutFichierTXT.ListeDossierFichier(Compteur)) - _
       Len(ToutFichierTXT.ListeFichier(Compteur)))
       FichRecap.WriteLine "Dossier : " & Chemin
       FichRecap.WriteLine "Fichier : " & ToutFichierTXT.ListeFichier(Compteur)
       FichRecap.WriteLine "-------------------------"
       FichRecap.WriteLine FichierACopier.ReadAll
       FichRecap.WriteLine ""
       FichierACopier.Close
       GestionFichier.MoveFile ToutFichierTXT.ListeDossierFichier(Compteur), _
       Chemin & "Obsolète " & ToutFichierTXT.ListeFichier(Compteur)
    End If
Next

Si vous exécutez la macro, à la fin, en plus d'avoir créé et rempli le fichier de récapitulation, tous les fichiers .txt de tous les dossiers et sous-dossiers se sont renommés, comme ceci :

Hop ! A la corbeille !

Dernière étape : on envoie tous les fichiers "Obsolète" à la corbeille. Vous me direz : Pourquoi passer son temps à renommer des fichiers, si c'est pour les effacer directement après ? ... Pour l'exercice .

Vous allez donc devoir copier les instructions nécessaires à l'utilisation de la corbeille dans l'en-tête de votre module, comme ceci :

Rappelez-vous : l'effacement d'un fichier est simple, mais son envoi à la corbeille nécessite l'utilisation d'une DLL.

Option Explicit
Declare Function SHFileOperation Lib "shell32.dll" Alias _
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Type SHFILEOPSTRUCT
     hwnd As Long
     wFunc As Long
     pFrom As String
     pTo As String
     fFlags As Integer
     fAnyOperationsAborted As Boolean
     hNameMappings As Long
     lpszProgressTitle As String
End Type
Private Declare Function _
SHGetSpecialFolderPath Lib "shell32.dll" Alias _
"SHGetSpecialFolderPathA" _
(ByVal hwndOwner As Long, ByVal lpszPath As String, _
ByVal nFolder As Long, ByVal fCreate As Long) As Long
Public Function DossierSpecial(ReferenceDossier As Long)
    Dim CheminAcces As String
    CheminAcces = Space(256)
    SHGetSpecialFolderPath 0, CheminAcces, ReferenceDossier, 0
    DossierSpecial = Left(CheminAcces, InStr(CheminAcces, Chr(0)) - 1)
End Function
Sub Corbeille(FichierAMettreDansLaCorbeille)
    Dim FileOperation As SHFILEOPSTRUCT
    Dim lReturn As Long
    Dim sFileName As String
    FileOperation.wFunc = &H3
    FileOperation.pFrom = FichierAMettreDansLaCorbeille
    ' le or &H10 précise qu'on ne veut pas de message de confirmation
    FileOperation.fFlags = &H40 or &H10
    SHFileOperation FileOperation
End Sub

Sub Exercice()
    ' Déclaration des variables :
    Dim DossierAnalyse ' Contient le dossier à analyser
    ...
    ...
    ...
    Set GestionFichier = Nothing
End Sub

Et maintenant, il s'agit d'envoyer tous les fichiers .txt à la corbeille, mais attention : on ne peut pas écrire :

       ...
       FichierACopier.Close
       GestionFichier.MoveFile ToutFichierTXT.ListeDossierFichier(Compteur), Chemin & "Obsolète " & 
         ToutFichierTXT.ListeFichier(Compteur)
       Corbeille ToutFichierTXT.ListeDossierFichier(Compteur)
    End If
Next
...

Parce que, justement, nous venons de les renommer ! Il va falloir envoyer les fichiers commençant par Obsolète, comme ceci :

Corbeille Chemin & "Obsolète " & ToutFichierTXT.ListeFichier(Compteur)

 

 

Si vous exécutez la macro, et que vous ouvrez votre corbeille, vous y verrez effectivement tous vos fichiers qui auront disparu du même coup de votre dossier de base :

Ouverture du fichier récapitulatif avec le bloc-notes

Il ne nous reste plus qu'à ouvrir le fichier récapitulatif avec le bloc-notes, comme nous l'avons vu.

           ...
           ToutFichierTXT.ListeFichier(Compteur)
           Corbeille Chemin & "Obsolète " & ToutFichierTXT.ListeFichier(Compteur)
        End If
    Next
    
    Shell "notepad.exe " & FichierRecapitulatif, vbNormalFocus
    
    ' C'est l'heure ! On ferme !
    FichRecap.Close
    Set ToutFichierTXT = Nothing
    Set GestionFichier = Nothing
End Sub

Et voilà !

C'est terminé.

Nous allons juste opérer à un dernier petit changement : nous proposons de créer le fichier de récapitulation dans le dossier-système Mes documents. Mais, l'utilisateur peut très choisir un autre dossier. Et s'il choisissait un dossier qui est en train d'être analysé ? vous imaginez le désordre ! Il créerait un fichier de récapitulation, qui se lirait lui même pour être récapitulé lui-même puisque c'est un fichier .TXT !

Afin d'éviter ceci, vous allez simplement changer la place de ce bout de code :

...
     FichierRecapitulatif = Left(FichierRecapitulatif, InStr(1, FichierRecapitulatif, ".")) & "txt"
End With
' Déplacer ces lignes barrées un peu plus bas :  
' Création simple du fichier de récapitulation :
Dim GestionFichier As New Scripting.FileSystemObject
Dim FichRecap As Scripting.TextStream
Dim FichierACopier As Scripting.TextStream
Set FichRecap = GestionFichier.CreateTextFile(FichierRecapitulatif)
' On n'écrit rien, on se contente de l'avoir créé...
FichRecap.Close
' Parcours de tous les fichiers textes
Dim ToutFichierTXT As New Recherche
ToutFichierTXT.Analyse DossierAnalyse
' Création simple du fichier de récapitulation :
Dim GestionFichier As New Scripting.FileSystemObject
Dim FichRecap As Scripting.TextStream
Dim FichierACopier As Scripting.TextStream
Set FichRecap = GestionFichier.CreateTextFile(FichierRecapitulatif)
' On n'écrit rien, on se contente de l'avoir créé...
FichRecap.Close
Set FichRecap = GestionFichier.OpenTextFile(FichierRecapitulatif, ForAppending)
' Boucle de parcours de tous les fichiers texte :
For Compteur = 1 To ToutFichierTXT.ListeFichier.Count
    ...

Vous avez compris l'histoire ? Le fichier texte est créé après l'analyse des dossiers... Le fichier de récapitulation ne sera donc pas pris en compte ! Astucieux, non ?

Code complet

Voici le code complet, mais il vous faudra vous assurer :

  1. D'avoir copié le code du module de classe personnalisé dans un module de classe appelé Recherche, afin de pouvoir analyser toute la structure d'un dossier et ses sous dossiers (Dim ToutFichierTXT As New Recherche)
  2. D'être allé dans le menu Outils/Références, et de cocher Microsoft Scripting RunTime, afin de pouvoir utiliser certains objets, tels que TextStream (lecture-écriture dans un fichier-texte, et MoveFile pour renommer les fichiers)
' Cette ligne rend la déclaration des variables obligatoires avec DIM :
Option Explicit

' Appel a une fonction API permettant l'usage de la Corbeille :
Declare Function SHFileOperation Lib "shell32.dll" Alias _
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Type SHFILEOPSTRUCT
     hwnd As Long
     wFunc As Long
     pFrom As String
     pTo As String
     fFlags As Integer
     fAnyOperationsAborted As Boolean
     hNameMappings As Long
     lpszProgressTitle As String
End Type

' Appel a une fonction API permettant l'appel des dossiers spéciaux
' (Mes documents en l'occurrence)
Private Declare Function _
SHGetSpecialFolderPath Lib "shell32.dll" Alias _
"SHGetSpecialFolderPathA" _
(ByVal hwndOwner As Long, ByVal lpszPath As String, _
ByVal nFolder As Long, ByVal fCreate As Long) As Long

' Fonction personnelle facilitant l'appel des dossiers spéciaux :
Public Function DossierSpecial(ReferenceDossier As Long)
    Dim CheminAcces As String
    CheminAcces = Space(256)
    SHGetSpecialFolderPath 0, CheminAcces, ReferenceDossier, 0
    DossierSpecial = Left(CheminAcces, InStr(CheminAcces, Chr(0)) - 1)
End Function

' Fonction personnelle facilitant le transfert des fichiers vers la corbeille :
Sub Corbeille(FichierAMettreDansLaCorbeille)
    Dim FileOperation As SHFILEOPSTRUCT
    Dim lReturn As Long
    Dim sFileName As String
    FileOperation.wFunc = &H3
    FileOperation.pFrom = FichierAMettreDansLaCorbeille
    FileOperation.fFlags = &H40 Or &H10
    SHFileOperation FileOperation
End Sub

Sub Exercice()
    ' Déclaration des variables :
    Dim DossierAnalyse ' Contient le dossier à analyser
    Dim FichierRecapitulatif ' Contient le chemin et le fichier de récapitulation
    Dim Compteur ' Compteur global
    Const Bureau = 16 ' Code de l'emplacement du bureau de l'utilisateur courant
    
    ' Sélection du dossier à analyser :
    With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Analyse ce dossier"
         .Title = "Choix du dossier à  analyser"
         .InitialFileName = ""
         If .Show = False Then  ' Si l'utilisateur clique sur Annuler
            Exit Sub
         End If
         DossierAnalyse = .SelectedItems(1)
    End With
    
    ' Choix du fichier de récapitulation :
    With Application.FileDialog(msoFileDialogSaveAs)
        .ButtonName = "Créer, et lancer l'analyse"
        .Title = "Création du fichier de récapitulation"
        .InitialFileName = DossierSpecial(Bureau) & "\NimporteQuoi"
        SendKeys "Récap" ' InitialFileName nous ajouterait .xlsx à la fin du fichier
        If .Show = False Then ' Si l'utilisateur clique sur Annuler
           Exit Sub
        End If
        FichierRecapitulatif = .SelectedItems(1)
        ' On enlève l'extension par défaut, et on la remplace par txt :
        FichierRecapitulatif = Left(FichierRecapitulatif, InStr(1, FichierRecapitulatif, ".")) & "txt"
    End With
    
    ' Parcours de tous les fichiers textes
    Dim ToutFichierTXT As New Recherche
    ToutFichierTXT.Analyse DossierAnalyse
    
    ' Création simple du fichier de récapitulation :
    Dim GestionFichier As New Scripting.FileSystemObject
    Dim FichRecap As Scripting.TextStream
    Dim FichierACopier As Scripting.TextStream
    Set FichRecap = GestionFichier.CreateTextFile(FichierRecapitulatif)
    ' On n'écrit rien, on se contente de l'avoir créé...
    FichRecap.Close
    
    Set FichRecap = GestionFichier.OpenTextFile(FichierRecapitulatif, ForAppending)
    ' Boucle de parcours de tous les fichiers texte :
    For Compteur = 1 To ToutFichierTXT.ListeFichier.Count
        If Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then
           Set FichierACopier = GestionFichier.OpenTextFile(ToutFichierTXT.ListeDossierFichier(Compteur), ForReading)
           FichRecap.WriteLine "-------------------------"
           Dim Chemin
           Chemin = Left(ToutFichierTXT.ListeDossierFichier(Compteur), _
           Len(ToutFichierTXT.ListeDossierFichier(Compteur)) - _
           Len(ToutFichierTXT.ListeFichier(Compteur)))
           FichRecap.WriteLine "Dossier : " & Chemin
           FichRecap.WriteLine "Fichier : " & ToutFichierTXT.ListeFichier(Compteur)
           FichRecap.WriteLine "-------------------------"
           FichRecap.WriteLine FichierACopier.ReadAll
           FichRecap.WriteLine ""
           FichierACopier.Close
           GestionFichier.MoveFile ToutFichierTXT.ListeDossierFichier(Compteur), Chemin & "Obsolète " & _
           ToutFichierTXT.ListeFichier(Compteur)
           Corbeille Chemin & "Obsolète " & ToutFichierTXT.ListeFichier(Compteur)
        End If
    Next
    
    Shell "notepad.exe " & FichierRecapitulatif, vbNormalFocus

    ' C'est l'heure ! On ferme !
    FichRecap.Close
    Set ToutFichierTXT = Nothing
    Set GestionFichier = Nothing
End Sub

Vous pouvez télécharger le fichier Excel qui contient le code complet ici.

Pour en savoir plus : Secrets Windows - Désavantages du FileSystemObjects