CSV Importieren

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: CSV Importieren
von: Thomas
Geschrieben am: 19.06.2015 14:54:12

Hallo,
mit dem untenstehendem Makro importiere ich alle csv Dateien aus einem bestimmten Ordner. Ist es möglich alle CSV Dateien aus allen Unterordnern zu Importieren?
Ich habe z.B. den Hauptordner "Werte" und in diesem Ordner befinden sich auch eine variable Anzahl von Unterordnen. In jedem Unterordner befindet sich eine CSV Datei die ich Importieren möchte. So zusagen brauche ich alle CSV die In diesem Hauptordner incl. Unterordner sind in ein Excelblatt.
bekommt man dies hin? Cool wäre wenn ich den Haupt Ordner über eine Abfrage angeben könnte.
Liebe grüsse thomas

Sub csv_untereinander()
'(C) Ramses
'Liest alle CSV-Dateien in einem Verzeichnis ein
Dim Datei As String, freeRow As Long
Dim Qe As Integer
Dim PFAD As String
PFAD = "D:\werte\" 'ACHTUNG: Bachslash am Schluss
Datei = Dir(PFAD & "*.csv")
Qe = MsgBox("Zum Import muss die aktuelle Tabelle leer sein," & vbCrLf & _
    "bzw. alle Daten der aktuellen Tabelle: "" " & ActiveSheet.Name & " "" werden gelöscht", _
    vbYesNo + vbCritical, "CSV-Import starten ?")
If Qe = vbNo Then
    MsgBox "CSV-Import abgebrochen"
    Exit Sub
Else
    Cells.Clear
End If
Do While Datei <> ""
    freeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & PFAD & Datei, Destination:=Range("A"  _
_
 _
 _
& freeRow))
        .Name = Datei
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Datei = Dir()
Loop
End Sub

Bild

Betrifft: AW: CSV Importieren
von: fcs
Geschrieben am: 20.06.2015 12:32:59
Hallo Thomas,
mit den folgenden Anpassungen werden alle CSV-Dateien in den Unterordnern mit erfasst.
Die Liste der CVS-Dateien wird dabei über ein weiteres Makro in einem Array erstellt und dann abgearbeitet.

Option Explicit
'Quelle: http://www. _
herber.de/forum/archiv/1064to1068/t1064122.htm#1064890
'Modifiziert: Franz Sielck 2010-08-07
Public lCount As Long, arrFiles() As String
Sub ListFilesInFolder(ByVal SourceFolderName As String, _
    Optional DateiFormat As String = "*.*", _
    Optional IncludeSubfolders As Boolean = False, _
    Optional FolderName As Boolean = False)
  '1.Parameter Ordner, wo soll gesucht werden?
  '2.Parameter Datei,* als Platzhalter verwenden,Optional leer ist alle
  '3.Parameter mit Unterordner = True, Optional False ist ohne
  '4.Parameter kompl. Pfad ausgeben = True, Optional nur Dateiname = False
  'Erstellt gemäß Suchkriterien ein Array mit den Dateinamen - optional inkl. Pfad
  Dim FSO As Object, SourceFolder As Object, SubFolder As Object
  Dim FileItem
  
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set SourceFolder = FSO.GetFolder(SourceFolderName)
        
  On Error GoTo Err_Zugriff: 'sollte Ordner geschützt sein
    For Each FileItem In SourceFolder.Files
        If LCase(FileItem.Name) Like LCase(DateiFormat) Then
          lCount = lCount + 1
          ReDim Preserve arrFiles(1 To lCount)
          arrFiles(lCount) = IIf(FolderName, FileItem, FileItem.Name)
        End If
    Next FileItem
    
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            ListFilesInFolder SubFolder.Path, DateiFormat, IncludeSubfolders, FolderName
        Next SubFolder
    End If
Err_Zugriff:
    Set FileItem = Nothing: Set SourceFolder = Nothing: Set FSO = Nothing
End Sub
Sub csv_untereinander()
'(C) Ramses
'Liest alle CSV-Dateien in einem Verzeichnis ein
    Dim Datei As Variant, freeRow As Long
    Dim Qe As Integer
    Dim PFAD As String
    
    Qe = MsgBox("Zum Import muss die aktuelle Tabelle leer sein," & vbCrLf & _
        "bzw. alle Daten der aktuellen Tabelle: "" " & ActiveSheet.Name & " "" werden gelöscht", _
 _
        vbYesNo + vbCritical, "CSV-Import starten ?")
    If Qe = vbNo Then
        MsgBox "CSV-Import abgebrochen"
        Exit Sub
    Else
        Cells.Clear
    End If
'Ordner auswählen
    With Application.FileDialog(msoFileDialogFolderPicker)
      .AllowMultiSelect = False
      .ButtonName = "Ordner wählen"
      .Title = "Bitte Haupt-ordner mit CSV-Dateien auswählen"
      .InitialView = msoFileDialogViewList
      If .Show <> False Then
        PFAD = .SelectedItems(1)
      Else
        Exit Sub
      End If
    End With
    
'Dateinamen einlesen
    Call ListFilesInFolder(SourceFolderName:=PFAD, _
          DateiFormat:="*.CSV", IncludeSubfolders:=True, FolderName:=True)
    If lCount = 0 Then
        MsgBox "Keine CSV-Dateien gefuden"
    Else
'Dateiliste abarbeiten
        For Each Datei In arrFiles
            freeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Datei, _
                Destination:=Range("A" & freeRow))
                .Name = Mid(Datei, InStrRev(Datei, "\") + 1)
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = 850
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileTabDelimiter = False
                .TextFileSemicolonDelimiter = True
                .TextFileCommaDelimiter = False
                .TextFileSpaceDelimiter = False
                .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
                .TextFileTrailingMinusNumbers = True
                .Refresh BackgroundQuery:=False
            End With
        Next
        Erase arrFiles: lCount = 0
    End If
End Sub


Bild

Betrifft: gelöst Besten dank Franz
von: Thomas
Geschrieben am: 21.06.2015 16:26:36
Hallo Franz,
besten Dank für die Hilfe dies spart mir stunden Arbeit besten dank.
PS. schaust Du mal bitte ob du das kopiermacro ändern kannst?
liebe grüsse Thomas

 Bild

Beiträge aus den Excel-Beispielen zum Thema "CSV Importieren"