Hallo liebe Gemeinde,
ich habe folgendes Problem und hoffe es gibt dafür eine Lösung!
Ich habe in mehreren Ordnern und Unterordnern verschieden Excel-Dateien.
Die Excel-Dateien haben alle einen unterschiedlichen Namen.
Allerdings, das ist das gute, die Daten die ich benötige stehen überall an derselben Stelle, da diese Dateien immer aus ein und derselben Vorlage genommen wurden.
Nun will ich mir eine Tabelle machen, wo ich per Button, bestimmte Daten z.B. Blattname: „2016“ und Zelle „A1“, „B1“ und „D4“ automatisch aus den vielen Excel-Dateien rausziehen kann!
Kurzfassung:
1 Hauptordner, darin viele Unterordner mit Unterordner, darin immer dieselbe Excel-Vorlage, nur anders benannt!
Danke für Eure Hilfe!
MfG
Hallo,
versuche mal diesen Code von snb:
Zuerst muss der Basis-Ordner eingegeben werden, dann sollte der Code alle *.xls* in allen Unterordnern auflististen. Wenn dann klappt, kann man nacheinander alle Dateien öffnen und die gesuchten Werte auslesen.
Code:
Sub M_snb_dir()
sn = Split(CreateObject("wscript.shell").exec("cmd /c dir ""c:\temp\*.xls"" /b/s").stdout.readall, vbCrLf)
For Each d In sn
Debug.Print d
Next d
End Sub
Sieh es ale Test, ob du über die mindest Kenntnisse verfügs.
mfg
Hallo
ich verweise höflich auf den Thread vom: 7.8.2016 19:02 Mehrere Exceldatein zu einer zusammenfassen
Darin gibt es eine Beispieldate zum Dateien öffneni: Dateien Öffnen.xls (Größe: 67 KB / Downloads: 4)
Ich weiss nicht ob man davon was brauchen kann? Einfach mal unverbindlich ansehen ...
Evtl. kann der vorhandene Code ja umgeschrieben swerden.
mfg Gast 123
Hallo, danke für eure Hilfe!
Also das Auslesen aus mehreren Excel funktionier super!
Nur habe ich das Problem, dass alle in EINEM Ordner liegen müssen.
mein kleines VBA soll aber auch in den Unterordnern nachsehen!
Danke
So sieht mein Code bis jetzt aus:
Sub suchen()
Dim strPath$, strFile$
Dim iRows&
strPath = "c:\Test\Test\"
strFile = Dir$(strPath & "*.xlsm", vbNormal)
iRows = 1
Do Until Len(strFile) = 0
.
.
.
.
.
.
Hi
es gibt einen sehr alten Code den ich einmal im Internet gefunden habe. Ich benutze ihn zum -alle Ordner- auflisten
Interessant für dich ist der 2. Teil. Sub Dateisuche(Laufwer, Dateien) Das interessante ist, er ruft sich im Programm selbst auf, wiederholt sich, bis alle Unterordner durchsucht wurden. Den Teil kannst du ja evtl. für dich umschreiben. Einfach ausprobieren.
mfg Gast 123
Code:
Dim z, unterordner As Variant
Sub Suchen()
Dim Laufwerk, Dateien As String
z = 2
'Tabellenbereich löschen
[a1:d4000] = ""
Laufwerk = "C:\"
Laufwerk = InputBox("In welchem Ordner wollen Sie suchen:", "Laufwerk & Ordner", "C:\")
If Laufwerk = "" Then Exit Sub
Unterordner = MsgBox("Unterordner mit einbeziehen?", vbYesNo, "Unterordner")
Dateien = "*.*"
Dateien = InputBox("Nach welchen Dateien wollen Sie suchen:", "Dateityp", "*.*")
If Dateien = "" Then Exit Sub
Dateisuche Laufwerk, Dateien
End Sub
Sub Dateisuche(Laufwerk, Dateien)
Dim temp, wdhlg, Dateiname As String
On Error Resume Next
If Right(Laufwerk, 1) <> "\" Then Laufwerk = Laufwerk + "\"
temp = Dir(Laufwerk & Dateien)
Do While Len(temp)
Dateiname = Laufwerk & temp
Application.StatusBar = Dateiname
Cells(z, 1).Select
Cells(z, 1) = Laufwerk & temp
Cells(z, 2) = FileLen(Laufwerk & temp)
Cells(z, 3) = FileDateTime(Laufwerk & temp)
Cells(z, 4) = temp
z = z + 1
temp = Dir()
Loop
temp = Dir(Laufwerk, vbDirectory)
If unterordner = vbNo Then temp=""
Do While Len(temp)
If (temp <> ".") And (temp <> "..") Then
If (GetAttr(Laufwerk & temp) And vbDirectory) = vbDirectory Then
Dateisuche Laufwerk & temp, Dateien
z = z - 1
wdhlg = Dir(Laufwerk, vbDirectory)
z = z + 1
Do While wdhlg <> temp
wdhlg = Dir()
Loop
End If
End If
temp = Dir()
Loop
On Error GoTo 0
Application.StatusBar = False
End Sub
(21.09.2016, 08:11)Fennek schrieb: [ -> ]Hallo,
versuche mal diesen Code von snb:
Zuerst muss der Basis-Ordner eingegeben werden, dann sollte der Code alle *.xls* in allen Unterordnern auflististen. Wenn dann klappt, kann man nacheinander alle Dateien öffnen und die gesuchten Werte auslesen.
Code:
Sub M_snb_dir()
sn = Split(CreateObject("wscript.shell").exec("cmd /c dir ""c:\temp\*.xls"" /b/s").stdout.readall, vbCrLf)
For Each d In sn
Debug.Print d
Next d
End Sub
Sieh es ale Test, ob du über die mindest Kenntnisse verfügs.
mfg
Das habe ich nun mittlerweile angepasst, kommt aber nur eine schwarzes Fenster, welches sich sofort wieder schließt, weiß nicht was ich damit anfangen soll!
Hallo,
das schwarze Fenster braucht Dich nicht zu beunruhigen, das kommt durch den Shell-Befehl. Der Punkt ist aber, dass Dir das Ergebnis im Direktfenster ausgegeben wird - ... Debug.Print ...
Das Direktfenster ist im VBA-Editor standardmäßig nicht geöffnet. Öffne es im VBA-Editor über das Menü| Ansicht | Direktfenster.