Exploration de répertoires en VBA

Question

Bonjour,

J'ai un répertoire parents C:\CLIENTS dans lequel il y a environ mille dossiers enfants, nommés comme suit :

C:\CLIENTS\1
C:\CLIENTS\2
...
C:\CLIENTS\3

A l'intérieur de chaque dossier enfant, un fichier HTML nommé comme suit :

C:\CLIENTS\1\UNTEL PATRICK.html
C:\CLIENTS\1\LAMBDA JACQUELINE.html
C:\CLIENTS\1\TOTO MICHEL.html
...

L'objectif final est de récupérer le contenu de certaines plages de ces fichiers HTML et de les copier dans un classeur nommé C:\dest.xls

Cela fonctionne avec une fiche HTML si je passe son nom en dur, mais pour moi il faudrait que mon script "scanne" le contenu de chaque dossier C:\CLIENTS\1, C:\CLIENTS\2... afin de récupérer le nom des fichiers HTML contenus à l'intérieur, les ouvrir et en exporter le contenu.

Voici une ébauche d'un script avec nom des dossiers en dur :


Sub EXPORT()
Dim CLASSEURORIGINE As Workbook
Dim CLASSEURDESTINATION As Workbook
Dim CHEMINPARENT As String
Dim CHEMINENFANT As String
Dim FEUILLEORIGINE As String

CHEMINPARENT = "C:\CLIENTS"
For i = 1 To 10
CHEMINENFANT = CHEMINPARENT & i
Next

On Error Resume Next

Set CLASSEURORIGINE = Workbooks.Open(Filename:="C:\CLIENTS\1\NOMPRENOM.html")
Set CLASSEURDESTINATION = Application.Workbooks.Open("C:\dest.xls", True)
CLASSEURORIGINE.Sheets("NOMPRENOM").Range("B167:C167").Copy
CLASSEURDESTINATION.Sheets("test").Range("A1").PasteSpecial (xlPasteValuesAndNumberFormats)
CLASSEURORIGINE.Sheets("NOMPRENOM").Range("B172:C172").Copy
CLASSEURDESTINATION.Sheets("test").Range("B1").PasteSpecial (xlPasteValuesAndNumberFormats)
CLASSEURORIGINE.Sheets("NOMPRENOM").Range("B173:C173").Copy
CLASSEURDESTINATION.Sheets("test").Range("C1").PasteSpecial (xlPasteValuesAndNumberFormats)
CLASSEURORIGINE.Sheets("NOMPRENOM").Range("B175:C175").Copy
CLASSEURDESTINATION.Sheets("test").Range("D1").PasteSpecial (xlPasteValuesAndNumberFormats)
CLASSEURORIGINE.Sheets("NOMPRENOM").Range("B177:C177").Copy
CLASSEURDESTINATION.Sheets("test").Range("E1").PasteSpecial (xlPasteValuesAndNumberFormats)
CLASSEURORIGINE.Sheets("NOMPRENOM").Range("B179:C179").Copy
CLASSEURDESTINATION.Sheets("test").Range("F1").PasteSpecial (xlPasteValuesAndNumberFormats)

Workbooks("dest.xls").Close savechanges:=True
End Sub

ucfoutu · Answer

Bonjour,
Pourquoi avoir ouvert dans la section 
 Forum > VB.NET et VB 2005
une discussion qui, traitant de VBA, aurait du l'être dans la section Langages dérivés > VBA ?
VBA n'est pas, ni de près ni de loi, du VB.Net !!!
Veille dorénavant à bien choisir la section dans laquelle tu ouvres une discussion.
Un administrateur bienveillant voudra bien déplacer la présente.

Pour ton problème :
à quoi te sert cette boucle surprenante :
For i = 1 To 10
  CHEMINENFANT = CHEMINPARENT & i
Next 
qui n'utilise pas son résultat CHEMINENFANT et qui fait que seule de dernier tour de la boucle sera utilisable, avec CHEMINENFANT étant "C:\CLIENTS\10" ????  ===>> ou est la logique (avant même de parler développement) ? On a beau la chercher, on ne la voit pas !!!
On voit encore moins où (nulle part, en fait) tu utilises ensuite cette variable CHEMINENFANT !!!!!
Tu n'ouvres plus bas que le fichier "C:\CLIENTS\1\NOMPRENOM.html", et ce : une seule fois, puisque hors de ta boucle précédente !!!
Un peu de logique, s'il te plait !
Reviens après avoir réfléchi.
Par ailleurs : en revenant : ne nous présente pas un code contenant un "On Error Resume Next", qui ne fait que cacher les failles. Teste sans lui, ne serait-ce que pour savoir ce qui ne va pas et nous dire le message d'erreur éventuel.
Bon ...
Ne te presse pas. Lis, relis tout de ce que j'ai écrit là ... analyse, prends ton temps, ... mais reviens avec du logique et du cohérent.
Le développement, c'est d'abord la logique et la clarté de son esprit.
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ

admicom · Answer

Pardon pour l'erreur de classement.

En réalité, c'était un premier jet.

En voici un nouveau plus abouti, mais qui bute sur le nommage des feuilles (sheets). J'ai du omettre quelque chose :

Sub EXPORT()
' Définition des classeurs
Dim CLASSEURORIGINE As Workbook
Dim CLASSEURDESTINATION As Workbook

'Définition des chemins
Dim CHEMINPARENT As String
Dim CHEMINCOMPLET As String
Dim FEUILLEORIGINE As String

Dim NOMFICHIER As String
CHEMINPARENT = "C:"

Dim Dossier As Object, Fichier As Object

Dim I As Long
For I = 1 To 60000
CHEMINCOMPLET = CHEMINPARENT & I
MsgBox CHEMINCOMPLET
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(CHEMINCOMPLET)
For Each Fichier In Dossier.Files
NOMFICHIER = Fichier.Name
CHEMINCOMPLET = CHEMINPARENT & NOMFICHIER
FEUILLEORIGINE = Left(Fichier.Name, InStr(Fichier.Name, ".") - 1)
MsgBox FEUILLEORIGINE
Set CLASSEURDESTINATION = Application.Workbooks.Open("C:\dest.xls", True)
CLASSEURORIGINE.Sheets(FEUILLEORIGINE).Range("B167:C167").Copy
CLASSEURDESTINATION.Sheets("test").Range("A" & I).PasteSpecial (xlPasteValuesAndNumberFormats)
CLASSEURORIGINE.Sheets(FEUILLEORIGINE).Range("B172:C172").Copy
CLASSEURDESTINATION.Sheets("test").Range("B" & I).PasteSpecial (xlPasteValuesAndNumberFormats)
CLASSEURORIGINE.Sheets(FEUILLEORIGINE).Range("B173:C173").Copy
CLASSEURDESTINATION.Sheets("test").Range("C" & I).PasteSpecial (xlPasteValuesAndNumberFormats)
CLASSEURORIGINE.Sheets(FEUILLEORIGINE).Range("B175:C175").Copy
CLASSEURDESTINATION.Sheets("test").Range("D" & I).PasteSpecial (xlPasteValuesAndNumberFormats)
CLASSEURORIGINE.Sheets(FEUILLEORIGINE).Range("B177:C177").Copy
CLASSEURDESTINATION.Sheets("test").Range("E" & I).PasteSpecial (xlPasteValuesAndNumberFormats)
CLASSEURORIGINE.Sheets(FEUILLE).Range("B179:C179").Copy
CLASSEURDESTINATION.Sheets("test").Range("F" & I).PasteSpecial (xlPasteValuesAndNumberFormats)

Workbooks("dest.xls").Close savechanges:=True
Next
Next
End Sub

ucfoutu · Answer

CHEMINCOMPLET = CHEMINPARENT & NOMFICHIER 

une simple msgbox de CHEMINCOMPLET te fera prendre conscience de l'oubli déjà fait ici !
FEUILLEORIGINE = Left(Fichier.Name, InStr(Fichier.Name, ".") - 1) 
Hein ? le nom de la feuille est dans le chemin du fichier ? Comprends pas, là !
Explique ce coup là !
Je t'avais pourtant demandé de réfléchir en prenant ton temps. 
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ

cirdec14 · Answer

Bonjour,

J'ai utilisé ton code et avec quelques modifications mineures , il fonctionne.

J'ai changé le fichier dest.xls en dest1.xls (c'est plus poétique dans ce monde de brutes )

Private Sub CommandButton1_Click()
' Définition des classeurs
Dim CLASSEURORIGINE As Workbook
Dim CLASSEURDESTINATION As Workbook

'Définition des chemins
Dim CHEMINPARENT As String
Dim CHEMINCOMPLET As String
Dim FEUILLEORIGINE As String
Dim NOMFICHIER As String
Dim Dossier As Object, Fichier As Object

Set CLASSEURDESTINATION = Workbooks.Open("G:\dest1.xls")

Dim I As Integer

For I = 1 To 2

CHEMINPARENT = "C:\CLIENTS"

CHEMINCOMPLET = CHEMINPARENT & I & ""

MsgBox CHEMINCOMPLET

Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(CHEMINCOMPLET)
For Each Fichier In Dossier.Files

NOMFICHIER = Fichier.Name
CHEMINCOMPLET = CHEMINCOMPLET & NOMFICHIER

FEUILLEORIGINE = Left(Fichier.Name, InStr(Fichier.Name, ".") - 1)
MsgBox FEUILLEORIGINE
MsgBox NOMFICHIER



Set CLASSEURORIGINE = Workbooks.Open(Filename:=CHEMINCOMPLET)

'  rapatrie dans dest1 le contenu des cellules B3 à C3 dans la colonne A sur les lignes 1 puis 2 jusqu'à I

CLASSEURORIGINE.Sheets(FEUILLEORIGINE).Range("B3:C3").Copy

CLASSEURDESTINATION.Sheets("test").Range("A" & I).PasteSpecial (xlPasteValuesAndNumberFormats)

Next
Next I

End Sub

cirdec14 · Answer

« La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi. Ici, nous avons réuni théorie et pratique : Rien ne fonctionne... et personne ne sait pourquoi !  »
de Albert Einstein

Exploration de répertoires en VBA

5 réponses

Votre réponse

Discussions similaires