Microsoft Excel

Herbers Excel/VBA-Archiv

Excel Dateien aus Ordner auslesen ..

Betrifft: Excel Dateien aus Ordner auslesen .. von: Stefan
Geschrieben am: 04.05.2007 22:40:38

Hi zusammen,
ich bin Außendiensttechniker und wollte statistisch mal erfassen wie viele Kilometer ich bisher gefahren bin.

Ich habe einen Windows Ordner in dem alle meine Spesenabrechnungen sind (alles Excel Arbeitsmappen mit einer Tabelle) in der Tabelle ist Spalte K von 7 bis 17 mit den Kilometern gefüllt.

Ich bin also auf der Suche nach einer Funktion die mir die Dateinamen aus dem Ordner holt und wie folgt in ein Excel Tabelle ausgibt:

Spalte A - Dateiname
Spalte B - gefahrene Kilometer (Summe aus der Tabelle K7 bis K17 aus Dateiname)

Wenn ich das händisch machen sollte würde ich dafür zu lange brauchen.
Und da ich mich mit VBA nicht so gut auskenne hoffe ich ganz fest auf eure Hilfe.

Danke im voraus!!!!

Gruß Stefan

  

Betrifft: AW: Excel Dateien aus Ordner auslesen .. von: Josef Ehrensberger
Geschrieben am: 04.05.2007 23:25:11

Hallo Stefan,

probier mal diesen Code. (Kommentare beachten!)

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub Daten_Lesen()
Dim strPath As String, strFile As String, strTabName As String
Dim lngR As Long

strPath = "F:\Temp\km\" 'Verzeichnis anpassen!

strTabName = "Tabelle1" 'Name der Tabellenblätter anpassen!

strFile = Dir(strPath & "*.xls")

lngR = 1

With ThisWorkbook.Sheets("Tabelle1") 'Name der Ausgabetabelle anpassen!
    
    .Range("A2:B" & Rows.Count).ClearContents
    
    Do Until strFile = ""
        lngR = lngR + 1
        .Cells(lngR, 1) = strFile
        .Cells(lngR, 2).Formula = "=SUM('" & strPath & "[" & strFile & "]" & _
            strTabName & "'!$K$7:$K$17)"
        .Cells(lngR, 2) = .Cells(lngR, 2).Value
        strFile = Dir
    Loop
    
End With

End Sub


Gruß Sepp



  

Betrifft: AW: Excel Dateien aus Ordner auslesen .. von: Stefan
Geschrieben am: 05.05.2007 00:01:23

Hi Sebb,
genau was ich gesucht habe funktioniert perfekt besten Dank!!!

Gruß Stefan


  

Betrifft: AW: Excel Dateien aus Ordner auslesen .. von: fcs
Geschrieben am: 04.05.2007 23:44:46

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




 

Beiträge aus den Excel-Beispielen zum Thema "Excel Dateien aus Ordner auslesen .."