Je vous propose ici un petit utilitaire sympathique qui vous permettra de lister dans une seule feuille de calcul l'ensemble de tous les fichiers qui se trouvent dans un dossier, lui même composés de sous-dossiers, eux-mêmes composés de sous-dossiers et ainsi de suite. Attention : ça ne fonctionne que pour un dossier, pas pour un lecteur. |
Sommaire
|
J'utilise énormément de notions que j'ai évoquées dans de didacticiel (les fichiers)
Commencez par télécharger le fichier Excel ici.
Il s'agit donc d'un fichier .xlsm et pas xlsx puisqu'il contient des macros.
Dès que vous l'ouvrez, vous avez ce formulaire qui s'affiche :
Il s'agit maintenant pour vous de sélectionner un dossier, et de cliquer sur le bouton Lister les fichiers.
Si vous désirez avoir la même arborescence de dossiers et de fichiers que moi, vous pouvez télécharger et décompresser ce fichier zip à la racine de votre disque dur (Chez moi, c'est sur le F:)
Voici le résultat :
Certaines lignes sont écrites en très petit, car la taille des caractères s'adapte automatiquement pour tout afficher sur une seule ligne. Si ça vous gêne, vous pouvez demander à ce qu'il arrête de faire ça, ou qu'il passe sur une 2ème ligne automatiquement.
C'est ici :
N'oubliez pas de sélectionner tout votre tableau avec CTRL-A avant de changer cet aliognement.
S'il existe des points dans les noms de fichiers, ce programme va estimer que c'est seulement le point le plus à droite qui constiture l'extension.
Dans cet exemple, on pourrait croire que l'extension est .amical.pps, mais je suis parti du principe que c'était juste pps.
Certains fichiers peuvent ne pas contenir d'extension :
Toutes les tailles sont données en octets. ces deux fichiers pèsent respectivement 27Ko et 1Mo :
Les chiffres ne sont pas alignées correctement pour la même raison évoquée plus haut.
Le nom de l'onglet créé automatiquement contient la date et l'heure,minute,seconde du jour. J'aurais bien aimé donner le nom du dossier analysé en plus, mais la taille maximum d'un onglet est de 31 caractères.
Je n'ai pas pu écrire "13:09:41" parce que le signe ":" est interdit dans les noms d'onglet.
Dans la cellule A2, vous avez le nombre de fichiers une fois la rec herche terminée. Quand vous scannerez un dossier contenant des milliers des fichiers, ce sera forcément beaucoup plus long (Comptez 10 minutes pour 150'000 fichiers), et du coup, mon programme va vous montrer l'avancement des choses petit à petit, comme sur l'image de droite (Il y a une première étape de scan, et une 2ème étape d'affichage).
Si vous désirez un autre onglet avec l'analyse d'un autre dossier, double cliquez ici :
Excel va alors créer un nouvel onglet avec votre nouvelle recherche. Rien ne vous empêche de re-scanner une deuxième fois le même dossier. Par exemple, imaginez que vous vous apprêtez à installer un programme, mais que vous redoutez qu'il efface, modifie ou ajoute des fichiers quelque part dans votre arborescence, mais vous ne savez pas lequel, ni où. Rien ne vous empêche de scanner votre dossier de base (Par exemple C:\Windows), installer votre programme, et re-scanner ensuite votre C:\Windows. Vous aurez alors la liste des fichiers actualisée.
Lorsque vous double-cliquez sur un fichier de la colonne A ou C, celui-ci se lance, exactement de la même manière que si vous aviez double-cliqué dessus depuis votre explorateur.
Si vous double-cliquez sur un dossier de la colonne B, alors, c'est votre explorateur Windows qui s'ouvre directement sur le dossier concerné.
Ensuite, vous pouvez évidemment trier par n'importe quelle colonne. Par exemple, si vous triez la colonne Taille par ordre décroissant, ça vous permettra d'afficher en premier les plus gros fichiers
Vous pouvez également filtrer les différentes colonnes.
Voici la marche à suivre pour visualiser l'ensemble de tous les fichiers qui se trouvent dans le dossier F:\Maison\Premier étage
Si vous désirez visualiser l'ensemble de tous les fichiers contenus dans le dossier F:\Maison\Premier étage, ainsi que dans tous les sous-dossiers de Premier étage, vous pouvez utiliser un filtre personnalisé.
En réalité, à partir de cette liste de fichiers, vous pouvez vous permettre de faire ce que vous voulez. Par exemple, pourquoi ne pas rechercher les doublons ? Existe-t-il des fichiers qui existent en plusieurs exemplaires ?
Marche à suivre :
Recherche de doublons avec NB.SI
Il reste une imperfection : avec ce système, sur les 3 "banane", seuls les deux derniers sont notés VRAI, ce qui est normal, puisqu'il compare la ligne actuelle avec la ligne précédente.
Or, ce serait quand même plus correct d'avoir les trois banane notés comme VRAI, et pas seulement les deux premiers.
Pour ce faire, nous allons utiliser une fonction plus gourmande en ressources, mais ô combien plus efficace ! C'est la fonction NB.SI. Son utilisation est extrêment simple : on lui donne simplement 2 renseignements : Où doit-il regarder, et qu'est-ce qu'il doit chercher, et lui, en réponse, il va nous dire combien il y a de fois le texte recherché.
Un petit exemple vaut mieux qu'un long discours :
Dans notre cas, nous allons remplacer
Par =NB.SI(C:C;C4). C'est à dire que nous allons fouiller dans toute la colonne C pour savoir combien il y a de fois le nom du fichier précisé dans la cellule C4 (Alcool au volant). Quand vous appuyez sur ENTER, vous voyez le résultat : 1.
Comme tout à l'heure avec =C4=C3, vous allez double-cliquer sur la petite croix noire de recopie pour recopier la formule jusqu'à en bas de la liste, et le miracle apparaît : vous avez maintenant le nombre d'exemplaire de chaque fichier :
L'autre gros avantage par rapport au simple =C4=C3 est que vous n'avez absolument pas besoin d'avoir votre liste triée par ordre alphabétique, du coup. Vous pouvez la trier par n'importe quelle autre colonne, les doublons seront toujours parfaitement comptés.
Afin de peaufiner le résultat, je pense que ce serait bien de ne voir le nombre de doublons que lorsqu'ils sont supérieurs à 1. Il n'y a pas grand intérêt à voir le chiffre 1 à côté des fichiers uniques.
Nous allons utiliser la fonction SI : Si (Le nombre de fichiers en doublons comptés est supérieur à 1 alors écrire le nombre de fichiers en doublons comptés, sinon ne rien écrire du tout)
Nous allons simplement remplacer le alors et le sinon par des points-virgule, comme ceci :
=SI(NB.SI(C:C;C4)>1;NB.SI(C:C;C4);"")
Et tirer la formule vers le bas comme les autres fois.
Comme je l'ai souligné plus haut, cette formule demande bien plus de ressources que la première formule =C4=C3. Si vous triez votre liste par une autre colonne, par exmeple la taille, Excel va recalculer toute la colonne E. L'idéal serait de transformer les formules de toutes la colonne E en valeurs fixes, puisque cette valeur ne va jamais changer.
Marche à suivre :
Il reste toutefois une "imperfection". C'est à dire que les doublons sont comptabilisés sans tenir compte de leur extension. Par exemple, le fichier Haricot vert est compté 3 fois, alors qu'en réalité, l'un des 3 est un .gif
Si vous désirez comptabiliser les doublons de fichiers parfaitement identiques (Nom de fichier, extension et taille par exemple), vous allez devoir créer une nouvelle colonne qui contient ces trois données concaténées (Attachées l'une éà l'autre.
Vous pouvez évidemment utiliser le Si, pour éviter l'affichage des 1, comme tout à l'heure. Regardez la différence :
Il peut être très intéressant de se rendre compte d'un seul coup d'oeil des fichiers les plus gros. Vous pouvez bien entendu trier par la colonne de stailles, mais il existe une mise en forme conditionnelle particulièrement bien adaptée à ce cas de figure.
Et voici le résultat : les fichiers les plus gros sont maintenant indiqués en rouge :
Et puisque nous sommes dans le format conditionnel, je vais vous montrer un epetite astuce : comment mettre une étoile jaune à côté des fichiers qui ont été accédé cette année (2014)
Marche à suivre :
Certaines dates sont maintenant précédées d'étoiles jaunes, jaunes et blanches et blanches.
Nous allons affiner. Ne cliquez pas dans une cellule, mais laissez la sélection des dates activée.
Résumons-nous :
Si la valeur de la cellule est supérieure ou égale au premier janvier 2014
Si la valeur de la cellule est à la fois < que le 1.1.2014 et en mêmne temps >= 1.1.2014, c'est à dire ... jamais !
Si la valeur de la cellule est plus petite que le 1.1.2014.
Dans ce didacticiel, je vais utiliser Excel 2010.
Allez dans VBA de n'importe quel programme, et créez un nouveau module :
Créez une nouvelle Macro Fichier1
:
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
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:
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.
Maintenant, la syntaxe est quelque peu différente : Essayez ceci :
Sub Fichier1() Dim GestionFichier AsObjectSet 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 !
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.
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.
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"
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", TrueOn 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
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
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/
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
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).
Sub CreerDossierAlternatif() MkDir "F:\Atelier\Casimir" End Sub
Tout comme pour la création d'un dossier, on peut le faire avec ou sans 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.
Avec RmDir (Acronyme de RemoveDirectory), par contre, il n'acceptera d'effacer le dossier que s'il est totalement vide :
RmDir "F:\Atelier\Armoire"
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.
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
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.Create
Folder "F:\Atelier\Etagere" MsgBox GestionFichier.FolderExists
("F:\Atelier\Etagere")' Vrai
GestionFichier.Delete
Folder "F:\Atelier\Etagere" MsgBox GestionFichier.FolderExists
("F:\Atelier\Etagere")' Faux
Set GestionFichier = Nothing End Sub
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 IfSet GestionFichier = Nothing End Sub
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.
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
MsgBox GestionFichier.GetFolder("F:\Atelier\Australie").Files.Count
MsgBox GestionFichier.GetFolder("F:\Atelier\Australie").SubFolders.Count
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.
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.NameSub ParcourtDossier() Dim GestionFichier As New Scripting.FileSystemObject
' On commence par définir une variable de type Folder :
Dim Dossier AsFolder
' 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 NextSet GestionFichier = Nothing End Sub
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 CompteurAs 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
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
Voici comment changer les attributs d'un fichier de manière plus simpliste :
Sub ChangeAttributAlternatif()
SetAttr "F:\Atelier\Test.txt", vbReadOnly +
vbHidden
End Sub
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.
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 :
MsgBoxFileLen
("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
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
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
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\")
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 IfSet GestionFichier = Nothing End Sub
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 :
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
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
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 :
SubA 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) :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).TotalSizeNext Set GestionFichier = Nothing End Sub
Sub BonneMethode() Dim GestionFichier As New Scripting.FileSystemObject' On déclare une variable de type Objet (Qui représentera un lecteur)
DimLecteur
AsObject
' 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.PrintLecteur
.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 asObject
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 IfNext 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.TotalSizeElse
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 = VIDESi vous désirez affiner l'affichage en Go ou en Mo, référez-vous au chapitre précédent.
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
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.
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 AsScripting.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é :
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 IfSet GestionFichier = Nothing End Sub
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.TextStreamSet FichierTexte = GestionFichier.
FichierTexte.OpenTextFile
("F:\Atelier\CommandePereNoel.txt", ForAppending
)WriteLine
("Poupée") FichierTexte.WriteLine
("Voiture en plastique") FichierTexte.CloseSet 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.ElseOpen
TextFile("F:\Atelier\ListeCommissions.txt", ForAppending)' Sinon
' On le crée avec CreateTextFile :
Set FichierTexte = GestionFichier.
End IfCreate
TextFile("F:\Atelier\ListeCommissions.txt")' 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
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", vbNormalFocusEnd 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.
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.
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.TextStreamSet FichierTexte = GestionFichier.OpenTextFile("F:\Atelier\ListePrenom.txt"
MsgBox FichierTexte.ReadLine, ForReading
)' 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 WendFichierTexte.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
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 ToUBound
(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
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" ForOutput
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" ForAppend
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" ForInput
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()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)' 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
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".
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.
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
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
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
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.
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.
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 IfEnd With
End Sub
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
"
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
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 :
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 :
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 ForCompteur
= 1 To.SelectedItems.Count
MsgBox .SelectedItems(Compteur
) Next End With End Sub
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 :
Pour sélectionner un dossier on doit donc utiliser msoFileDialogFolderPicker
Application.FileDialog(msoFileDialogFolder
Picker).Show MsgBox Application.FileDialog(msoFileDialogFolder
Picker).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
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
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 !
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.
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.
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.
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
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) NextSet 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) NextSet 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
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.CountIf
Debug.Print MaRecherche.ListeFichier(Ctr) End If NextRight
(MaRecherche.ListeFichier(Ctr),3
) = "jpg
" OrRight
(MaRecherche.ListeFichier(Ctr),3
) = "gif
" ThenSet 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 WithSet 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
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 .ListeDossier
Fichier(Ctr)Kill .ListeFichier(Ctr)End IfNext
End With
Set MaRecherche = Nothing
End Sub
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
WhileDossierVideTrouve = 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
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.
Nous allons utiliser FileDialog(msoFileDialogFolderPicker), comme nous l'avons vu ici :
Sub Exercice()
Application.FileDialog(msoFileDialogFolder
Picker).Show
MsgBox Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End Sub
Lorsque l'utilisateur a sélectionné un dossier, son chemin complet s'affiche :
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
ThenExit Sub
End If MsgBox Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) End Sub
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
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 IfFichierRecapitulatif
= Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1) MsgBox FichierRecapitulatifEnd 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 =
MsgBox FichierRecapitulatif End SubLeft
(FichierRecapitulatif,InStr(1, FichierRecapitulatif, ".")
) &"txt"
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\Videos16 : C:\Users\MichelD\Desktop19 : C:\Users\MichelD\AppData\Roaming\Microsoft\Windows\Network Shortcuts20 : 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
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
DimToutFichierTXT
As New RechercheToutFichierTXT
.AnalyseDossierAnalyse
SetToutFichierTXT
= 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
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
ForCompteur
=1
To ToutFichierTXT.ListeFichier.Count
' Si le fichier actuel se termine par .txt...
IfRight
(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.
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.FileSystemObjectNe 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)DimFichRecap
As Scripting.TextStream' Création effective (Sans doute sur votre bureau si vous avez accepté la proposition)
SetFichRecap
= 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 = NothingDim 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 :
DimFichierACopier
As Scripting.TextStream
' ICI, les instructions pour ajouter le contenu des autres fichiers
SetFichierACopier
= 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)
ForCompteur
= 1 To ToutFichierTXT.ListeFichier.CountIf Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then
Dim FichierACopier As Scripting.TextStream
Set FichierACopier = GestionFichier.OpenTextFile(ToutFichierTXT.Liste
MsgBox FichierACopier.ReadAllDossier
Fichier(Compteur
), ForReading)' 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.TextStreamSet 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.TextStreamSet FichierACopier = GestionFichier.OpenTextFile(ToutFichierTXT.ListeDossierFichier(Compteur), ForReading)
Debug.Print "-------------------------" Debug.PrintToutFichierTXT.ListeDebug.Print "Fichier : "Dossier
(Compteur)&
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.CountIf Right(ToutFichierTXT.ListeFichier(Compteur), 4) = ".txt" Then
Dim FichierACopier As Scripting.TextStreamFichierACopier = 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.TextStreamSet
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.CloseDim 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.CountIf 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
NextFichRecap.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 ""
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.CountIf 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 "-------------------------"
DimChemin
Chemin
= Left(ToutFichierTXT.ListeDossierFichier(Compteur), _Len(ToutFichierTXT.ListeDossierFichier(Compteur)) - _ Len(ToutFichierTXT.ListeFichier(Compteur))) FichRecap.WriteLine "Dossier : "
FichRecap.WriteLine "Fichier : " & ToutFichierTXT.ListeFichier(Compteur) FichRecap.WriteLine "-------------------------" FichRecap.WriteLine FichierACopier.ReadAll FichRecap.WriteLine "" FichierACopier.Close GestionFichier.MoveFile ToutFichierTXT.ListeDossierFichier(Compteur), _& Chemin
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 :
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 TypePrivate 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 = &H40or &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.CloseGestionFichier.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 :
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 ?
Voici le code complet, mais il vous faudra vous assurer :
' 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" ThenSet 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.CloseGestionFichier.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