AW: Excel Dateien aus Ordner auslesen ..
04.05.2007 23:44:46
fcs
Hallo Stefan,
folgendes Makrobeispiel erstellt eine neue Abeitsmappe und liest dann die Dateien im Verzeichnis aus.
Sub Import_km()
'Fügt aus allen Dateien des Ordners die Summe aus dem Zellbereich in eine Zelle ein
Dim wbKM As Workbook, wb As Workbook
Dim wksKM As Worksheet
Dim Verzeichnis As Variant, ZellBereich$
Dim i As Integer, ZeileKM As Long
'Neue Arbeitsmappe mit 1 Tabelle anlegen
Set wbKM = Workbooks.Add(Template:=xlWBATWorksheet)
Set wksKM = wbKM.Worksheets(1)
ZeileKM = 1 'Zeile für Spaltentitel in der Tabelle in der Daten eingetragen werden
Verzeichnis = "C:\Test\Daten" 'Hier Verzeichnis anpassen
ZellBereich$ = "K7:K17" 'Zellbereich der summiert wird
'zur Beschleunigung der Codeausführung
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Dateien im Verzeichnis Suchen und abarbeiten
With Application.FileSearch
.NewSearch
.LookIn = Verzeichnis
.FileName = "*.xls"
.SearchSubFolders = False
.MatchTextExactly = True
wksKM.Cells(ZeileKM, 1) = "Dateiname"
wksKM.Cells(ZeileKM, 2) = "Summe-km"
wksKM.Columns(2).NumberFormat = "#,##0" ' Beispiel(deutsch): 2.000
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Application.StatusBar = "Datei " & i & " von " & .FoundFiles.Count & " wird bearbeitet"
'Nächste freie Zeile im Blatt in Spalte A ermitteln
ZeileKM = wksKM.Cells(wksKM.Rows.Count, 1).End(xlUp).Row + 1
Set wb = Workbooks.Open(FileName:=.FoundFiles(i), ReadOnly:=True)
wksKM.Cells(ZeileKM, 1).Value = wb.Name ' oder wb.FullName, wenn mit Verzeichnis
wksKM.Cells(ZeileKM, 2).Value = _
Application.WorksheetFunction.Sum(wb.Worksheets(1).Range(ZellBereich$))
wb.Close savechanges:=False
Next i
Application.StatusBar = False
End If
End With
'Spaltenbreite optimal einstellen
wksKM.Columns.AutoFit
'Beschleunigungseinstellungen zueücksetzen
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Dialogs(xlDialogSaveAs).Show
End Sub