10.5k Aufrufe
Gefragt in Tabellenkalkulation von bigo Einsteiger_in (31 Punkte)
Schönen guten Tag euch allen,
dieses Problem wurde schonmal hier im Forum behandelt aber leider bin ich nicht weiter gekommen....
Ich habe einen Ordner mit einer Menge von unterordnern die nicht nur Excel dateien enthalten.
Aus diesen Excel Dateien die alle mit Form_ anfangen benötige ich nur D20 F28 und D10 eventuell auch eine mehr.
Die inhalte der Zellen sollen dann ein einer Tabelle aufgelistet werden.

Mich würde es sehr freuen wenn ich eine Antwort bekommen würde

Viele Grüße
Bigo

PS: excel 2007

14 Antworten

0 Punkte
Beantwortet von tumbawamba Einsteiger_in (59 Punkte)
http://www.shareware.de/software/ordner-durchsuchen/
Versuche es mal hier.

So wie ich dich verstanden habe, willst du in den Excel Dateien
bestimmte Zeilen herauskopieren ohne in die Dateien selbst zu gehen?
Bin mir nicht sicher ob das geht,....
0 Punkte
Beantwortet von coros Experte (4k Punkte)
Hallo Bigo!

Nachfolgender VBA-Code sollte das machen, was Du Dir vorstellst.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Dim objFileSystemObject As Object
Dim objDateien As Object
Dim objWeitereDateien As Object
Dim objDatei As Object
Dim lngFirstFreeRow As Long
Dim wksAuswertsheet As Worksheet
'###########################################################################################

Sub Auswertung_start()
'Objektverweise zuweisen
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set objDateien = objFileSystemObject.getfolder("C:\Test")
Set wksAuswertsheet = ThisWorkbook.Sheets("Auswertung")

Call Dateien_auswerten

'Zuweisung wieder aufheben
Set objFileSystemObject = Nothing
Set objDateien = Nothing
Set wksAuswertsheet = Nothing

'Text aus Statusbar löschen
Application.StatusBar = ""
End Sub
'###########################################################################################

Sub Dateien_auswerten()

Application.ScreenUpdating = False

For Each objDatei In objDateien.Files
If Right(objDatei.Name, 4) = ".xls" Or Right(objDatei.Name, 5) = ".xlsx" _
Or Right(objDatei.Name, 5) = ".xlsm" Then

'erste freie Zelle in der Zieldatei in Spalte A ermitteln
lngFirstFreeRow = wksAuswertsheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'Meldung in Statusbar anzeigen
Application.StatusBar = "Datei """ & objDatei.Name & """ wird ausgelesen!"
DoEvents

'Gefundene Datei unsichtbar öffnen
GetObject (objDatei)

'Wert aus geöffneter Datei aus dem Tabellenblatt 1 aus Zelle _
D20 in die erste freie Zelle in Spalte A übertragen
wksAuswertsheet.Cells(lngFirstFreeRow, 1) = _
Workbooks(objDatei.Name).Sheets(1).Range("D10")

'Wert aus geöffneter Datei aus dem Tabellenblatt 1 aus Zelle _
D20 in die erste freie Zelle in Spalte A übertragen
wksAuswertsheet.Cells(lngFirstFreeRow, 2) = _
Workbooks(objDatei.Name).Sheets(1).Range("D20")

'Wert aus geöffneter Datei aus dem Tabellenblatt 1 aus Zelle _
D20 in die erste freie Zelle in Spalte A übertragen
wksAuswertsheet.Cells(lngFirstFreeRow, 3) = _
Workbooks(objDatei.Name).Sheets(1).Range("F28 ")

'Geöffnete Datei wieder schließen ohne zu speichern
Workbooks(objDatei.Name).Close SaveChanges:=False

End If
Next

'Nächstes Verzeichnis abfragen
For Each objWeitereDateien In objDateien.subfolders
Set objDateien = objWeitereDateien
Call Dateien_auswerten
Next

End Sub
'###########################################################################################


Das Makro liest Dir alle Dateien in einem Hauptverzeichnis und die darin befindlichen Unterverzeichnisse aus. Es werden nur Dateien mit der Endung „xls“, „xlsx“ und „xlsm“ ausgelesen und die Werte aus den Zellen D10, D20 und F28 in die erste freie Zeile in den Spalten A, B und C übertragen.
Du musst allerdings in dem Code noch ein paar Dinge anpassen. Zunächst den Hauptpfad, in dem sich dann die ganzen Unterverzeichnisse befinden. Dazu ändere in der Zeile

Set objDateien = objFileSystemObject.getfolder("C:\Test")

den Pfad “C:\Test” gegen Deinen Pfad aus. Aber Achtung, der Pfad gehört zwischen die beiden Anführungsstriche. Außerdem musst Du die Blattindexzahl ändern, wenn die Daten nicht im 1. Tabellenblatt der auszulesenden Datei stehen. Dazu in dem VBA-Code in den Zeilen, in denen

Workbooks(objDatei.Name).Sheets(1).Range(……

steht die Zahl bei Sheets(1) gegen die Zahl des auszulesenden Tabellenblatts ändern.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

Bei Fragen melde Dich.

MfG,
Oliver
[sup]Jeder macht was er will, keiner macht was er soll, aber alle machen mit.[/sup]
0 Punkte
Beantwortet von bigo Einsteiger_in (31 Punkte)
Hallo Oliver,
wirklich super das einem hier so gut geholfen wird, find ich spitze,
nur leider funktioniert das nicht,.

zunächst werde ich gefragt welchen marko ich ausführen möchte
Auswertung_start oder Dateien_auswerten

bei Auswertung start kommt Laufzeitfehler 9
index ausserhalb des gültigen bereichs
für
Set wksAuswertsheet = ThisWorkbook.Sheets("Auswertung")

und bei Dateien_auswerten kommt
Laufzeitfehler 91
objektvarianble oder with-blockvariable nicht festgelegt
For Each objDatei In objDateien.Files

zudem möcht ich sagen das ich es bisher mit demhier ausprobiert habe

Sub Daten_kopieren()
Dim Pfad As String, Dateiname As String, iRow As Long
Application.ScreenUpdating = False
Pfad = "c:........"
Dateiname = Dir(Pfad & "*.xls")
Do While Dateiname <> "F"
Application.Dialogs(xlDialogOpen).Show
iRow = ThisWorkbook.Sheets("Tabelle1").Range("I61").End(xlUp).Offset(1, 0).Row
Workbooks(Dateiname).Sheets("PF-Check").Range("D20").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 1).PasteSpecial
Workbooks(Dateiname).Sheets("PF-Check").Range("F28").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 2).PasteSpecial
Workbooks(Dateiname).Sheets("PF-Check").Range("D10").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 3).PasteSpecial
Workbooks(Dateiname).Close
Dateiname = Dir()
Loop

aber das haut auch nie funktioniert, vermutlich zum einen weil meine dateien schreibgeschützt sind, und es nicht mit open funktion sondern mit einer show funktion geöffnet werden muss, und zum anderen weil er immer
laufzeit fehler 9
index ausserhalb gültigen bereichs für
Workbooks(Dateiname).Sheets("PF-Check").Range("D20").Copy
ausgegeben hat.


ich weiß es ist ein komplizierter Fall:(

bedanke mich vielmals für eure bemühungen
0 Punkte
Beantwortet von coros Experte (4k Punkte)
Hallo Bigo!

Füge in der Datei, in der die Daten aufgelistet werden sollen das Blatt "Auswertung" hinzu und starte das Makro "Auswertung_start ". Dann sollten die Makros funktionieren.

MfG
Oliver
[sup]Jeder macht was er will, keiner macht was er soll, aber alle machen mit.[/sup]
0 Punkte
Beantwortet von bigo Einsteiger_in (31 Punkte)
Super jetzt funktionieren die ersten, leider unterbricht er und sagt,
laufzeitfehler '-2147467259(80004005)':
Automatisierungsfehler
Unbekannte Fehler

für
GetObject (objDatei)
0 Punkte
Beantwortet von bigo Einsteiger_in (31 Punkte)
Nun ist es so, das es bei den ersten 3 Dateien geklappt hat, aber leider auch so, das sich jetzt die ersten 4 Dateien nicht mehr öffnen lassen, es kommt eine DDE fehlermeldung( Ein DDE-Fehler ist aufgetrete, und die Fehlerbeschreibung ist zu lang, um angezeigt zu werden. Wenn der Dateiname oder der Pfad sehr lang sind, versuchen sie, die Datei umzubenennen oder in einen anderen Ordner zu verschieben)
ich kann die dateien aber nicht verschieben oder unbenennen.
jetzt weis ich wirklich nicht mehr weiter
0 Punkte
Beantwortet von coros Experte (4k Punkte)
Hallo Bigo!

Damit Du die Dateien wieder öffnen kannst, füge unter der Zeile

GetObject (objDatei)


die Zeile

Windows(objDatei.Name).Visible = True


ein. Dein Code müsste dann an der Stelle wie folgt aussehen:

GetObject (objDatei)
Windows(objDatei.Name).Visible = True


Das Makro wird mit der Änderung auch wieder in den Fehler laufen. Die Änderung behebt zwar nicht den Fehler, mit dem ich im Moment noch nichts anfangen kann, blendet aber Deine Dateien wieder ein, so dass Du diese wieder öffnen können solltest.

MfG,
Oliver
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi all ^^

stringlänge des Dateinamens oder Sonderzeichen waeren einige ansaetze

gruss nighty
0 Punkte
Beantwortet von bigo Einsteiger_in (31 Punkte)
Danke Danke,
also ich hab den ordner auf C: kopiert dann hat alles geklappt,
ich denke dass das problem ist das der Dateiname mit dem Pfad zusammen länger als 256 zeichen ist.
ist es möglich, das man den Pfad auf den mein makro zugreift irgentwie weiter unten anzusetzen damit der Pfad+Dateiname in Summe kürzer ausfällt? also nicht zum beispiel D://programme/ordner/unterordner/unterordner/projekt/252165454datei
sondern
D://projekt/252165454datei?
0 Punkte
Beantwortet von nighty Experte (6.6k Punkte)
hi :-)

wechsle zuvor den ordner mit chdir ^^

gruss nighty
...