Onderliggende mappen uitlezen voor copy-paste

[barrytas]

Ik lees nu workbooks uit en kopieer bepaalde waarde uit deze sheets naar een Mastersheet.

Heb hiervoor wat code gebruikt van dit forum en dat gaat goed zolang ik de uit te lezen sheets in 1 specifieke map plaats. vb "c:\bronsheets\".

Const BronPad As String = "c:\bronsheets\"
Dim BronBoek As String, BronPadBoek As String
Dim BronSheet As Worksheet
Dim DoelSheet As Worksheet
Dim RijLoper As Long

Set DoelSheet = ActiveWorkbook.Worksheets(1)
BronBoek = Dir(BronPad & "*.xls")
RijLoper = 1
Do Until BronBoek = ""
BronPadBoek = BronPad + BronBoek
Workbooks.Open Filename:=BronPadBoek, ReadOnly:=True
Set BronSheet = ActiveWorkbook.Worksheets(2)

De bronbestanden bevinden zich echter in 10 onderliggende mappen dus
"c:\bronsheets\eerste\"
"c:\bronsheets\tweede\"
"c:\bronsheets\etc...."

Ik moet nu iedere keer alle bestanden kopiëren naar bovenste map.
Mijn vraag is dan ook: Hoe kan het uitlezen ook direct vanuit de onderliggende mappen zonder dat ik de WB's eerst moet kopiëren?

Alvast bedankt, Barry

 

[edmoor]

Doe het eens zo. Maak in de map C:\Bronsheets een .bat bestand met de naam Books.bat en de volgende inhoud:
@DIR /b /s C:\Bronsheets\*.xls* > C:\Bronsheets\Books.txt

Dit .bat bestand kun je laten uitvoeren door je code. Er wordt dan een bestandje gemakt in diezelfde map met de naam Books.txt
In je code kan je dat bestand uitlezen. De namen van alle Excel documenten uit bronmap inclusief de submappen staan erin.

 Const BronPad As String = "c:\bronsheets\"
 Dim BronBoek As String, BronPadBoek As String
 Dim BronSheet As Worksheet
 Dim DoelSheet As Worksheet
 Dim RijLoper As Long
    
 Set DoelSheet = ActiveWorkbook.Worksheets(1)

 'Maak het Books.txt bestand
 Shell (BronPad & "\Books.bat")

 'Open dat bestand
 Open BronPad & "\Books.txt" For Input As #1

 'Lees de regels per stuk en behandel het betreffende document
 Do Until EOF(1)
     Line Input #1, BronBoek
     RijLoper = 1
     'BronPadBoek = BronPad + BronBoek
     Workbooks.Open Filename:=BronBoek, ReadOnly:=True
     Set BronSheet = ActiveWorkbook.Worksheets(2)
 Loop

 Close #1

Er zijn meerdere manieren maar deze is het kortst en het makkelijkst.
De variabele BronPadBoek heb je dan niet meer nodig.

 

[barrytas]

Edmoor,

Dank voor snelle bericht. Ga morgen direct mee aan de slag!

 

[barrytas]

Edmoor,

Werkt perfect zoals je beschreef. Een kleine issue....Leest alle onderliggende sheets uit, maar alles wordt nu over elkaar gepaste. Maw de Rijloper variabele verhoogt nu niet meer met +1 per file....hoe doe je dit zodat Rijloper begint met waarde 1 en dan volgend loop wordt +2, etc...


Barry

===========

Sub OpenLeesSluitFiles()
Const BronPad As String = "C:\Suppliers\"
Dim BronBoek As String, BronPadBoek As String
Dim BronSheet As Worksheet
Dim DoelSheet As Worksheet
Dim RijLoper As Long


Set DoelSheet = ActiveWorkbook.Worksheets(1)
DoelSheet.Range("A2:Z999").ClearContents

'Maak het Books.txt bestand
Shell (BronPad & "Books.bat")
'Open dat bestand
Open (BronPad & "Books.txt") For Input As #1

'Lees de regels per stuk en behandel het betreffende document
Do Until EOF(1)
Line Input #1, BronBoek
RijLoper = 1
Workbooks.Open Filename:=BronBoek, ReadOnly:=True
Set BronSheet = ActiveWorkbook.Worksheets(2)

DoelSheet.Cells(RijLoper + 1, 1) = BronSheet.Range("A4")
DoelSheet.Cells(RijLoper + 1, 2) = BronSheet.Range("B4")
DoelSheet.Cells(RijLoper + 1, 3) = BronSheet.Range("c4")
DoelSheet.Cells(RijLoper + 1, 4) = BronSheet.Range("d4")

ActiveWorkbook.Close SaveChanges:=False

Loop

Close #1



End Sub

 

[edmoor]

In #1 heb je niet je volledige code laten zien dus kon ik ook niet zien waar de rijloper wordt verhoogt. Dat moet uiteraard wel in een loop gebeuren. Na het openen van een werkboek staat RijLoper op 1. Ik kan niet zeggen waar en hoe je deze vervolgens moet verhogen om dat ik geen kijk heb op wat er veder gebeurt, afgezien van de vier regeltjes waarin RijLoper +1 staat. Deze komt op de manier zoals het er staat nooit boven de 2 uit.

Zet RijLoper = 1 eens buiten de Loop, dus net voor de Do Until EOF(1)

 

[barrytas]

Opgelost.

Heb RijLoper = 1 voor start vd Loop gezet en vlak voor het einde van de Loop toegevoegd: Rijloper = Rijloper +1....

Zo simpel kan het dus zijn!

Superbedankt voor je hulp!

 

[edmoor]

Ok dan :thumb: