Hallo tw..
A)In der Anlage eine Datei mit einem Makro, so wie ich es verstanden habe.
Für das Makro benötigt die Datei :
1) eine Zelle mit Namen "
Verzeichnis" in dem das zu durchsuchende Verzeichnis eingetragen werden muss.
2) eine Zelle mit Namen "
Ausgabe" ab der die Ergebnisse geschrieben werden. (Mit genügend Platz unter und neben der Zelle, da die Daten dort gnadenlos überschrieben werden.)
3) ein Ereignis, das das Makro aufruft.
B)Es werden zur Zeit noch Spalten mit Verzeichnis, Datei und Blatt mit ausgegeben die aber in den Konstanten des Programms abgeschaltet werden können.
C)Folgende Parameter können im Programm eingestellt werden in Klammern die aktuelle Einstellung.
a) intMaxVerz (30)
Begrenzung der zu durchsuchenden Verzeichnisse, falls du mal aus Versehen das oberste Verzeichnis eines Servers einträgst.
b) intMaxblatt (2)
Die ersten n Blätter einer Datei werden bearbeitet.
c) strRngDatum ("C4")
d) strRngKopie ("B6:E55")
Falls du aus den Blättern mehrere Bereiche untereinander ausgegeben haben möchtest, kannst du sie mit Leerzeiche getrennt eintragen.
e) bolZeigVerz (True)
f) bolZeigDatei (True)
g) bolZeigBlatt (True)
h) bolZeigLeer (True)
Code:
Sub Lese()
Dim intBereich As Integer
Dim intZeile As Integer
Dim intSpalte As Integer
Dim strDatei As String
Dim intAnzVerz As Integer
Dim intAktVerz As Integer
Dim intAktBlatt As Integer
Dim intAktZeile As Integer
Dim intAktSpalte As Integer
Dim intSpDatum As Integer
Dim intSpBlatt As Integer
Dim intSpDatei As Integer
Dim intSpVerz As Integer
Dim strVerz As String
Dim strVerzA() As String
Dim varDatum As Variant
Dim varKopie As Variant
Dim varRngKopie As Variant
Dim bolLeer As Boolean
Dim rngAusgabe As Range
Dim wbLesen As Workbook
Dim wsLesen As Worksheet
Const intMaxVerz As Integer = 30
Const intMaxblatt As Integer = 2
Const strTeilDatei As String = ".xlsx"
Const strRngDatum As String = "C4"
Const strRngKopie As String = "B6:E55"
Const bolZeigVerz As Boolean = True
Const bolZeigDatei As Boolean = True
Const bolZeigBlatt As Boolean = True
Const bolZeigLeer As Boolean = True
Application.ScreenUpdating = False
'----------------------------------------------------
' Spalten für Verzeichnis, Datei und Blatt einrichten
'----------------------------------------------------
intSpDatum = 0
intSpBlatt = 0
intSpDatei = 0
intSpVerz = 0
If bolZeigBlatt Then
intSpDatum = intSpDatum + 1
End If
If bolZeigDatei Then
intSpDatum = intSpDatum + 1
intSpBlatt = intSpBlatt + 1
End If
If bolZeigVerz Then
intSpDatum = intSpDatum + 1
intSpBlatt = intSpBlatt + 1
intSpDatei = intSpDatei + 1
End If
varRngKopie = Split(strRngKopie)
'----------------------------------------------------
' Verzeichniseinlesen und Variablen initialisieren
'----------------------------------------------------
ReDim strVerzA(intMaxVerz)
intAktVerz = 1
intAnzVerz = 1
intAktZeile = 0
strVerzA(intAnzVerz) = ThisWorkbook.Names("Verzeichnis").RefersToRange
Set rngAusgabe = ThisWorkbook.Names("Ausgabe").RefersToRange
'----------------------------------------------------
' Schleife über Verzeichnisse
'----------------------------------------------------
While intAktVerz <= intAktVerz And intAktVerz <= intMaxVerz
strVerz = strVerzA(intAktVerz)
strDatei = Dir(strVerz, vbDirectory)
'----------------------------------------------------
' Schleife über Dateien im Verzeichnis
'----------------------------------------------------
While strDatei <> ""
If (GetAttr(strVerz & strDatei) And vbDirectory) = vbDirectory Then
If strDatei <> "." And strDatei <> ".." And strDatei <> "" And intAnzVerz < intMaxVerz Then
intAnzVerz = intAnzVerz + 1
strVerzA(intAnzVerz) = strVerz & strDatei & "\"
End If
Else
If InStr(strDatei, strTeilDatei) > 0 And strDatei <> ThisWorkbook.Name Then
intAktBlatt = 0
Set wbLesen = Workbooks.Open(Filename:=strVerz & strDatei, ReadOnly:=True)
For Each wsLesen In wbLesen.Worksheets
intAktBlatt = intAktBlatt + 1
If intAktBlatt <= intMaxblatt Then
varDatum = wsLesen.Range(strRngDatum)
For intBereich = 0 To UBound(varRngKopie)
varKopie = wsLesen.Range(varRngKopie(intBereich)).Value
For intZeile = 1 To UBound(varKopie, 1)
'----------------------------------------------------
' Prüfen ob Werte leer
'----------------------------------------------------
If bolZeigLeer Then
bolLeer = False
Else
bolLeer = True
For intSpalte = 1 To UBound(varKopie, 2)
If varKopie(intZeile, intSpalte) <> "" Then
bolLeer = False
End If
Next intSpalte
End If
'----------------------------------------------------
' Schreiben wenn nicht leer
'----------------------------------------------------
If Not bolLeer Then
For intSpalte = 1 To UBound(varKopie, 2)
rngAusgabe.Offset(intAktZeile, intSpalte + intSpDatum).Value = varKopie(intZeile, intSpalte)
Next intSpalte
rngAusgabe.Offset(intAktZeile, intSpVerz).Value = strVerz
rngAusgabe.Offset(intAktZeile, intSpDatei).Value = strDatei
rngAusgabe.Offset(intAktZeile, intSpBlatt).Value = wsLesen.Name
rngAusgabe.Offset(intAktZeile, intSpDatum).Value = varDatum
intAktZeile = intAktZeile + 1
End If
Next intZeile
Next intBereich
End If
Next wsLesen
wbLesen.Close savechanges:=False
End If
End If
strDatei = Dir()
Wend
intAktVerz = intAktVerz + 1
Wend
Application.ScreenUpdating = True
End Sub
