VBA - Naviguation dans dossiers - sous dossiers

[Tom]

Bonjour à tous !

Je suis bien embêté, je programme en VBA mais je n'ai jamais dû faire une macro qui fasse appel à de la navigation dans différents dossiers !

Je m'explique :

Je veux compiler les données de plusieurs fichiers Excel dans mon fichier central (comportant la macro).

Mon fichier récap se situe sur C/Tom/Récap/Fichierrécap.xls
Mes fichiers sur lesquels je veux récupérer des données se trouvent sur : C/Tom/Dossier1/fichier.xls (1 seul fichier dans le Dossier1) , C/Tom/Dossier2/fichier.xls (1 seul fichier dans le Dossier2) etc.

Alors j'ai bien réussi à remonter dans l'arborescence, avec la fonction c = Mid(ThisWorkbook.Path, 1, InStrRev(ThisWorkbook.Path, "\")- 1), pour me trouver dans mon dossier Tom, mais après, impossible d'arriver à ouvrir un des dossiers dans ce dossier-ci.

La difficulté, c'est que je ne peux pas appeler chaque fichier directement par son nom, il faut que je fasse l'intégralité des dossiers dans "Tom" pour qu'on aie les données des nouveaux fichiers dans de nouveaux dossiers qu'on aura plus tard.

Les manipulations à faire sont, pour chaque fichier : l'ouvrir, récupérer les données de cellules bien définies (à chaque fois les mêmes pour chaque fichier), coller ces données dans le fichier récap et fermer le fichier, puis passer au fichier suivant dans le dossier suivant.

Je précise que je ne souhaite pas changer l'arborescence de mes dossiers pour garder la trame actuelle qui est plus lisible (beaucoup de dossiers, sous-dossiers par mois etc.)

Je vous remercie pour toute aide que vous pourrez m'apporter, cette macro me sera très utile dans le cadre de mon travail !

 

[john]

Re : VBA - Naviguation dans dossiers - sous dossiers

Bonsoir,

Je pourrai avoir un exemple du fichier que tu dois importer ??
Tous tes fichiers ont la même structure ??
Où copier les données dans le fichier récap ?? si tu sais, joins-le également...
Dès que j'ai ça, je te fais ce que tu aimerais obtenir... j'ai fais un programme dans le même style il y a pas très longtemps...

Bonne soirée.
John

 

[job75]

Re : VBA - Naviguation dans dossiers - sous dossiers

Bonsoir Tom, john,

Le code dans le fichier "FichierRécap", à compléter en ce qui concerne le traitement des données :

Sub TraitementFichiers()
Dim dossier$, nomdos$, n&, liste$(), nomfich$, fichier As Workbook
dossier = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\"))
'---liste des sous-dossiers---
nomdos = Dir(dossier, vbDirectory) '1er dossier
While nomdos <> ""
  If nomdos <> "." And nomdos <> ".." Then
    n = n + 1
    ReDim Preserve liste(1 To n)
    liste(n) = nomdos
    MsgBox nomdos 'pour tester
  End If
  nomdos = Dir 'dossier suivant
Wend
'---traitement des fichiers---
If n Then
  Application.ScreenUpdating = False
  For n = 1 To UBound(liste)
    nomfich = Dir(dossier & liste(n) & "\*.xls*") '1er fichier
    While nomfich <> ""
      If nomfich <> ThisWorkbook.Name Then
        MsgBox nomfich 'pour tester
        Set fichier = Workbooks.Open(dossier & liste(n) & "\" & nomfich)
        'placer ici le code du traitement des données
        fichier.Close True 'enregistrement et fermeture
      End If
      nomfich = Dir 'fichier suivant du dossier
    Wend
  Next
End If
End Sub

A+

 

[john]

Re : VBA - Naviguation dans dossiers - sous dossiers

Bonjour Tom, Job75,

En fait je voulais avoir tes fichiers, car de la façon que je veux faire (et que j'ai déjà fais), c'est d'éviter d'ouvrir tous les fichiers... d'où gain de temps si il y a beaucoup de fichiers à traiter...

Sinon ta solution est bonne Job75 si ça convient comme ça à Tom

Bonne journée.

John

 

[Tom]

Re : VBA - Naviguation dans dossiers - sous dossiers

Merci grandement à vous 2 ! Je pense que le code de job75 me convient, je vais tester ça et je vous tiendrai au courant !

 

[job75]

Re : VBA - Naviguation dans dossiers - sous dossiers

Bonjour Tom, john, le forum,

Si l'on veut exclure le dossier "Récap" de la liste des sous-dossiers :

Sub TraitementFichiers()
Dim dossier$, nomdosexclu$, nomdos$, n&, liste$(), nomfich$, fichier As Workbook
dossier = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\"))
nomdosexclu = Mid(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") + 1)
'---liste des sous-dossiers---
nomdos = Dir(dossier, vbDirectory) '1er dossier
While nomdos <> ""
  If nomdos <> "." And nomdos <> ".." And nomdos <> nomdosexclu Then
    n = n + 1
    ReDim Preserve liste(1 To n)
    liste(n) = nomdos
    MsgBox nomdos 'pour tester
  End If
  nomdos = Dir 'dossier suivant
Wend
'---traitement des fichiers---
If n Then
  Application.ScreenUpdating = False
  For n = 1 To UBound(liste)
    nomfich = Dir(dossier & liste(n) & "\*.xls*") '1er fichier
    While nomfich <> ""
      If nomfich <> ThisWorkbook.Name Then
        MsgBox nomfich 'pour tester
        Set fichier = Workbooks.Open(dossier & liste(n) & "\" & nomfich)
        'placer ici le code du traitement des données
        fichier.Close False 'fermeture sans enregistrement
      End If
      nomfich = Dir 'fichier suivant du dossier
    Wend
  Next
End If
End Sub

Par ailleurs s'il y a un seul fichier dans chacun des sous-dossiers quel est l'intérêt des sous-dossiers ?

A+

 

[job75]

Re : VBA - Naviguation dans dossiers - sous dossiers

Re,

S'il s'agit uniquement de récupérer les valeurs de certaines cellules, pas besoin d'ouvrir les fichiers.

Cette macro utilise ExecuteExcel4Macro pour récupérer les valeurs des cellules A2 B2 C2 de la feuille "MaFeuille".

Cerise sur le gâteau, un lien hypertexte est créé en colonne A du fichier "FichierRécap" :

Sub TraitementFichiers()
Dim dossier$, nomdosexclu$, nomdos$, n&, liste$()
Dim F As Worksheet, lig&, nomfich$, x$, y$, v1, v2, v3
dossier = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\"))
nomdosexclu = Mid(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") + 1)
'---liste des sous-dossiers---
nomdos = Dir(dossier, vbDirectory) '1er dossier
While nomdos <> ""
  If nomdos <> "." And nomdos <> ".." And nomdos <> nomdosexclu Then
    n = n + 1
    ReDim Preserve liste(1 To n)
    liste(n) = nomdos
  End If
  nomdos = Dir 'dossier suivant
Wend
'---traitement des fichiers---
Set F = ActiveSheet 'feuille de restitution, à adapter
lig = 2
If n Then
  For n = 1 To UBound(liste)
    nomfich = Dir(dossier & liste(n) & "\*.xls*") '1er fichier
    While nomfich <> ""
      x = "'" & dossier & liste(n) & "\[" & nomfich & "]MaFeuille'!"
      y = liste(n) & "\" & nomfich
      v1 = ExecuteExcel4Macro(x & "R2C1") 'A2
      v2 = ExecuteExcel4Macro(x & "R2C2") 'B2
      v3 = ExecuteExcel4Macro(x & "R2C3") 'C2
      F.Hyperlinks.Add F.Cells(lig, 1), dossier & y, TextToDisplay:=y
      F.Cells(lig, 2) = v1
      F.Cells(lig, 3) = v2
      F.Cells(lig, 4) = v3
      lig = lig + 1
      nomfich = Dir 'fichier suivant du dossier
    Wend
  Next
End If
F.Rows(lig & ":" & F.Rows.Count).Delete
End Sub

A+

 

[Droussel]

Re : VBA - Naviguation dans dossiers - sous dossiers

bonjour john

je reprends une ancienne discussion car je crois que tu as ma solution
dans un répertoire j'ai 10 à 30 fichiers csv (exemple joint)

je voudrai les ramener dans un seul fichier excel

est ce possible

voici mon code
et merci de ton aide

Sub integrationfichier()

Dim OuvrirFichiers As Variant
Dim NomFichierinventaire As Variant

ChDir "E:\DR EL\INVENTAIRE\2014\fichiers inventaires"

OuvrirFichiers = Application.GetOpenFilename _
(filefilter:="fichier novastock (*.csv),*.csv", _
Title:="Ouverture des fichiers novastock")
Workbooks.Open Filename:=OuvrirFichiers
NomFichierinventaire = ActiveWorkbook.Name

Range("A1:C10000").Select
Selection.Copy
Windows("inventaire newman.xlsm").Activate

'manque position sur premiere cellule vide

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows(NomFichierinventaire).Activate
ActiveWindow.Close
End Sub