Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

gelöst Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen

Mitglied: 113139

113139 (Level 1)

27.08.2013 um 09:31 Uhr, 35959 Aufrufe, 42 Kommentare, 3 Danke

Hallo liebe Community,

Ich bin neu im Forum und hoffe ihr könnt mir vielleicht helfen
Ich habe einen Ordner, in dem sich mehrere CSV Dateien befinden.
Diese möchte ich per Makro in Ecxel importieren.
Und zwar so, dass sie bei der ausgabe gleich das richtige Zeilen- und Spaltenformat haben.
Der Ordner wird ab und zu aktualisiert, d.h. dieses Makro sollte dann bei Ausführung die jeweils aktuellen Dateien im Ordner in Ecxel importieren und veraltete Dateien, die evtl noch vorhanden sind ersetzen.
Ich habe bereits ein Makro im Internet gefunden, welches alle Dateien auf einmal einliest, allerdings war das Tabellen Layout meiner CSV Dateien dabei verschwunden.
Sie wurden fortlaufend in eine Zeile geschrieben und dieses Problem würde ich sehr gerne umgehen.
Ich würde mich sehr über eure Hilfe freuen

LG Lemon
42 Antworten
Mitglied: colinardo
27.08.2013, aktualisiert um 13:40 Uhr
Hallo Lemon,
das könntest du z.B. so realisieren:
Das Makro öffnet jede CSV-Datei in einem Ordner, führt die Spaltenerkennung durch und kopiert den Inhalt in ein Worksheet mit dem Namen der CSV-Datei in deine Excel-Datei. Die Optionen für die Texterkennung der CSV-Datei musst du an das Format deiner CSV-Dateien in Zeile 25 des Codes anpassen. Im Beispiel werden Semikolons zur Spaltentrennung verwendet. Den Pfad zu den CSV-Dateien musst du noch in Zeile 2 des Codes anpassen.
01.
Sub ImportiereCSVDateien()
02.
    Const CSVPFAD = "E:\csv-dateien"
03.
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet
04.
    Set fso = CreateObject("Scripting.Filesystemobject")
05.
    Set wbTarget = ActiveWorkbook
06.
    Application.DisplayAlerts = False
07.
    'Lösche alle Worksheets bevor wir alle neu anlegen
08.
    If wbTarget.Worksheets.Count > 1 Then
09.
        For i = 1 To wbTarget.Worksheets.Count - 1
10.
            wbTarget.Worksheets(i).Delete
11.
        Next
12.
    End If
13.
    For Each f In fso.GetFolder(CSVPFAD).Files
14.
        If LCase(Right(f.Name, 3)) = "csv" Then
15.
            Workbooks.OpenText Filename:=f.Path
16.
            Set wbSource = ActiveWorkbook
17.
            On Error Resume Next
18.
            Set ws = wbTarget.Worksheets(f.Name)
19.
            If Err <> 0 Then
20.
                Set ws = wbTarget.Worksheets.Add
21.
                ws.Name = f.Name
22.
                ws.Range("A:ZZ").Clear
23.
            End If
24.
        
25.
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
26.
            wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
27.
            wbSource.Close False
28.
        End If
29.
    Next
30.
    Application.DisplayAlerts = True
31.
    Set fso = Nothing
32.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: 113139
27.08.2013 um 14:07 Uhr
Hallo Uwe,

Vielen Dank für deine schnelle Antwort.
Ich neu was das programmieren und das arbeiten mit Scripts angeht und habe deswegen immernoh ein paar Probleme Fehler in meinen Dateien und Scripts zu erkennen. Ich habe dein Makro gleich ausprobiert und VBA markiert mir gleich die erste Zeile gelb "Sub ImportiereCSVDateien()" und verweist mich auf "Set fso" in der 4. Zeile. Den Pfad der Dateien habe ich schon eingetragen. Weißt du vllt woran das leigen könnte?

LG Lemon
Bitte warten ..
Mitglied: colinardo
27.08.2013 um 14:17 Uhr
Ich hoffe du hast das Script von dieser Seite nicht inklusive der Zeilennummern in dein VBA Projekt kopiert !! Dazu gibt es den Link "Quelltext" oben rechts des Codes.
Bitte warten ..
Mitglied: 113139
29.08.2013 um 08:36 Uhr
Ne Ne^^ nur den reinen Text.
Bitte warten ..
Mitglied: colinardo
29.08.2013 um 08:41 Uhr
Hast du zufällig Oben im Codefenster Option Explicit stehen ?, dann lösch es mal raus.
Welche Fehlermeldung bringt dein Excel denn dazu?
Habe das Script hier erfolgreich getestet...

Grüße Uwe
Bitte warten ..
Mitglied: 113139
29.08.2013 um 11:01 Uhr
Ah super jetzt klappts
Vielen Dank!!!

Ich habe zum Test 3 Dateien im Ordner gehabt.
Er hat mir für jede ein neues Tabellenblatt angelegt.
Kannst du mir vllt noch verraten, wie er zusätzlich noch eins erstellt, in dem alle aufeinmal aufgelistet werden?
Wäre echt klasse

Aber trotzdem schonmal vielen Dank für das tolle Makro
Das macht die ganze Sache erheblich leichter

Gruß Lemon
Bitte warten ..
Mitglied: colinardo
29.08.2013, aktualisiert 09.03.2017
Zitat von 113139:
Kannst du mir vllt noch verraten, wie er zusätzlich noch eins erstellt, in dem alle aufeinmal aufgelistet werden?
Wäre echt klasse
01.
Sub ImportiereCSVDateien()
02.
    Const CSVPFAD = "E:\csv-dateien"
03.
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, ts As Worksheet
04.
    Set fso = CreateObject("Scripting.Filesystemobject")
05.
    Set wbTarget = ActiveWorkbook
06.
    Application.DisplayAlerts = False
07.
    'Lösche alle Worksheets bevor wir alle neu anlegen
08.
    While wbTarget.Worksheets.Count > 1
09.
            wbTarget.Worksheets(1).Delete
10.
    Wend
11.
    wbTarget.Worksheets(1).Name = "Zusammenfassung"
12.
    wbTarget.Worksheets(1).Range("A:ZZ").Clear
13.
    For Each f In fso.GetFolder(CSVPFAD).Files
14.
        If LCase(Right(f.Name, 3)) = "csv" Then
15.
            Workbooks.OpenText Filename:=f.Path, DataType:=xlFixedWidth
16.
            Set wbSource = ActiveWorkbook
17.
            On Error Resume Next
18.
            Set ws = wbTarget.Worksheets(f.Name)
19.
            If Err <> 0 Then
20.
                Set ws = wbTarget.Worksheets.Add
21.
                ws.Name = f.Name
22.
                ws.Range("A:ZZ").Clear
23.
            End If
24.
        
25.
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
26.
            wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
27.
            wbSource.Close False
28.
        End If
29.
    Next
30.
    Set ts = wbTarget.Worksheets("Zusammenfassung")
31.
    Dim curCell As Range
32.
    Set curCell = ts.Range("A1")
33.
    For i = 1 To wbTarget.Worksheets.Count - 1
34.
        maxRow = wbTarget.Worksheets(i).Range("A1").End(xlDown).Row
35.
        maxCol = wbTarget.Worksheets(i).Range("A1").End(xlToRight).Column
36.
        wbTarget.Worksheets(i).Range(wbTarget.Worksheets(i).Cells(1, 1), wbTarget.Worksheets(i).Cells(maxRow, maxCol)).Copy Destination:=curCell
37.
        Set curCell = curCell.End(xlDown).Offset(2, 0)
38.
    Next
39.
    Application.DisplayAlerts = True
40.
    Set fso = Nothing
41.
End Sub
Viel Spaß
Grüße Uwe
Bitte warten ..
Mitglied: 113139
30.08.2013 um 14:34 Uhr
Hallo Uwe,

Alles klappt total super einwandfrei!
Vielen Vielen Dank

Grüße Lemon
Bitte warten ..
Mitglied: colinardo
30.08.2013 um 15:04 Uhr
gern geschehen!
Bitte den Beitrag noch als gelöst markieren.

Grüße Uwe
Bitte warten ..
Mitglied: sommer2013
11.03.2014, aktualisiert um 10:11 Uhr
Hallo zusammen,

ich bin auch neu hier und bin begeistert, dass ich das gefunden habe, was ich schon lange suche.

Der Import der CSV-Dateien aus einem Ordner in eine Excel Datei klappt sehr gut. Allerdings habe ich noch ein kleines Problem:

aus ursprünglich:
"
Trendlogs

Timestamp Trend__Archive1
30.01.2014 00:07 190,387
30.01.2014 00:22 190,387
30.01.2014 00:37 190,388
30.01.2014 00:52 190,389
30.01.2014 01:07 190,390
.
.
.
.
....

"

wird folgendes importiert:
"
Trendlogs

Timestamp Trend__Archive1
30.01.2014 00:07:36 190
30.01.2014 00:22:35 190
30.01.2014 00:37:34 190
30.01.2014 00:52:34 190
30.01.2014 01:07:33 190
.
.
.
.
...."
Zeilen >10000


Dabei wird die Nachkommastelle des Messwertes abgeschnitten (190,xxx). Durch Umformatierung kann die Nachkommastelle nicht zurückgeholt werden.

Ich hätte da noch ein zweites Anliegen, bei dem ich ohne Hilfe nicht weiter komme:

Ich habe im Grunde ca. 50 solcher Einzel-Dateien in eine Datei zu importieren. Im Idealfall sollten alle Daten allerdings auf ein Tabellenblatt gelangen und nicht jede Datei ein eigenes Tabellenblatt erhalten. Jede von mir zu importierende Datei hat zwei Spalten (1.Spalte mit Datum und Uhrzeit; 2. Spalte mit Messwert) die immer vollständig zu importieren sind.


Ich bin für jeden Tipp/jede Hilfe dankbar!!!
Grüße Markus
Bitte warten ..
Mitglied: colinardo
11.03.2014, aktualisiert um 11:18 Uhr
Hallo Markus, Willkommen im Forum!
das Problem ist das Excel hier beim Import via Code das englische Zahlenformat benutzt, wenn du bei den Zahlen das Komma durch einen Punkt ersetzt wird es richtig importiert.
Hier aber eine Lösung die das automatisch macht und alle CSV-Daten in ein Sheet untereinander importiert und die Überschriften dabei nicht wiederholt.
Da du oben kein Trennzeichen für die Spalten der CSV-Datei angegeben hast habe ich mal das Semikolon als Trennzeichen genommen (lässt sich in Zeile 19 / zweiter Parameter festlegen). Den Pfad zu den CSV-Dateien legst du in Zeile 3 fest.
Zum starten des Imports muss die Prozedur ImportiereCSVDateien() gestartet werden.

01.
Sub ImportiereCSVDateien()
02.
    Dim ws As Worksheet, header As Boolean, startRange As Range, curRange As Range, counter As Integer
03.
    Const CSVPFAD = "E:\csvdateien"
04.
    Set fso = CreateObject("Scripting.Filesystemobject")
05.
    Set ws = Worksheets(1)
06.
    ws.Range("A:ZZ").Clear
07.
    Set startRange = ws.Range("A1")
08.
    Set curRange = startRange
09.
    Application.DisplayAlerts = False
10.
    counter = 1
11.
    For Each f In fso.GetFolder(CSVPFAD).Files
12.
        If LCase(Right(f.Name, 3)) = "csv" Then
13.
            Dim importHeader As Boolean
14.
            If counter = 1 Then
15.
                header = True
16.
            Else
17.
                header = False
18.
            End If
19.
            importCSV f.Path, ";", curRange, header
20.
            Set curRange = curRange.End(xlDown).Offset(1, 0)
21.
            counter = counter + 1
22.
        End If
23.
        
24.
    Next
25.
    ws.ListObjects.Add xlSrcRange, ws.Range(startRange, curRange.Offset(-1, curRange.Offset(-1, 0).End(xlToRight).Column - 1))
26.
    Application.DisplayAlerts = True
27.
    Set fso = Nothing
28.
End Sub
29.
 
30.
Function importCSV(strPath, delim, ByVal targetRange As Range, ByVal importHeader As Boolean)
31.
    Dim intStart As Integer
32.
    Set fso = CreateObject("Scripting.FileSystemObject")
33.
    Set regex = CreateObject("vbscript.regexp")
34.
    patNumber = "^([\d\.,\+\-]+)$"
35.
    arrLines = Split(fso.OpenTextFile(strPath, 1).ReadAll(), vbNewLine, -1, vbTextCompare)
36.
    Set rngCurrent = targetRange
37.
    If importHeader Then
38.
        intStart = 0
39.
    Else
40.
        intStart = 1
41.
    End If
42.
    For i = intStart To UBound(arrLines)
43.
        If arrLines(i) <> "" Then
44.
            cols = Split(arrLines(i), delim, -1, vbTextCompare)
45.
            For c = 0 To UBound(cols)
46.
                rngCurrent.Offset(0, c).ClearFormats
47.
                wert = Trim(Replace(cols(c), """", "", 1, -1, vbTextCompare))
48.
                ' check for Numberformat
49.
                regex.Pattern = patNumber
50.
                Set matches = regex.Execute(wert)
51.
                If matches.Count > 0 Then
52.
                    wert = Replace(matches(0).Submatches(0), ",", ".", 1, -1, vbTextCompare)
53.
                End If
54.
                ' set value in cell
55.
                rngCurrent.Offset(0, c).Value = wert
56.
            Next
57.
            Set rngCurrent = rngCurrent.Offset(1, 0)
58.
        End If
59.
    Next
60.
    Set fso = Nothing
61.
    Set regex = Nothing
62.
End Function
Grüße Uwe
Bitte warten ..
Mitglied: Zebras
01.04.2014 um 21:44 Uhr
Hi,
dieses Makro ist echt super! Aber ist es auch möglich, an Stelle die Daten untereinander aufzuführen, diese nebeneinander auf zu listen? Wäre sehr dankbar, wenn jemand mir helfen würde =)
Bitte warten ..
Mitglied: colinardo
01.04.2014, aktualisiert um 23:41 Uhr
Zitat von Zebras:

Hi,
dieses Makro ist echt super! Aber ist es auch möglich, an Stelle die Daten untereinander aufzuführen, diese
nebeneinander auf zu listen? Wäre sehr dankbar, wenn jemand mir helfen würde =)
in Teil 2 steht die Lösung für dich parat:
https://www.administrator.de/forum/alle-csv-dateien-in-einem-ordner-mit- ...

Grüße Uwe
Bitte warten ..
Mitglied: Zebras
02.04.2014 um 08:59 Uhr
Perfekt. Vielen vielen Dank. Komm mir zwar etwas blöd vor, dass ich das selbst nicht gesehen habe, aber naja... ^^
Bitte warten ..
Mitglied: KurinoKi
22.08.2014 um 09:56 Uhr
Hallo Uwe,

vielen Dank für das tolle Skript.

Ich war genau danach auf der Suche und es funktioniert auch super, allerdings habe ich leider noch eine Frage dazu und habe mich dafür nun auch extra in diesem Forum angemeldet.

Die Spalten A, C, F, und evtl. noch B und H müssen beim Import als Text formatiert werden, da diese führende Nullen haben.
Wo muss das Skript hierzu angepasst werden. Ich habe leider noch gar keine Erfahrung mit VBA Skript und benötige hier leider Hilfe.

Vielen Dank im voraus.

Grüße,
Stephy
Bitte warten ..
Mitglied: colinardo
22.08.2014, aktualisiert 13.10.2014
Hallo Stephy, Willkommen auf Administrator.de!
vielen Dank für das tolle Skript.
keine Ursache
Die Spalten A, C, F, und evtl. noch B und H müssen beim Import als Text formatiert werden, da diese führende Nullen haben.
Wo muss das Skript hierzu angepasst werden. Ich habe leider noch gar keine Erfahrung mit VBA Skript und benötige hier leider Hilfe.
dazu habe ich dir mal die Import-Funktion angepasst, die die gewünschten Spalten der CSV als Text importiert. Tausche die Funktion einfach durch diese aus:
Die Änderungen findest du in Zeile 25-31
01.
Function importCSV(strPath, delim, ByVal targetRange As Range, ByVal importHeader As Boolean)
02.
    Dim intStart As Integer
03.
    Set fso = CreateObject("Scripting.FileSystemObject")
04.
    Set regex = CreateObject("vbscript.regexp")
05.
    patNumber = "^([\d\.,\+\-]+)$"
06.
    arrLines = Split(fso.OpenTextFile(strPath, 1).ReadAll(), vbNewLine, -1, vbTextCompare)
07.
    Set rngCurrent = targetRange
08.
    If importHeader Then
09.
        intStart = 0
10.
    Else
11.
        intStart = 1
12.
    End If
13.
    For i = intStart To UBound(arrLines)
14.
        If arrLines(i) <> "" Then
15.
            cols = Split(arrLines(i), delim, -1, vbTextCompare)
16.
            For c = 0 To UBound(cols)
17.
                rngCurrent.Offset(0, c).ClearFormats
18.
                wert = Trim(Replace(cols(c), """", "", 1, -1, vbTextCompare))
19.
                ' check for Numberformat
20.
                regex.Pattern = patNumber
21.
                Set matches = regex.Execute(wert)
22.
                If matches.Count > 0 Then
23.
                    wert = Replace(matches(0).Submatches(0), ",", ".", 1, -1, vbTextCompare)
24.
                End If
25.
               ' Spalten A, B, C, D, F, H als Text importieren
26.
                If c = 0 Or c = 1 Or c = 2 Or c = 5 Or c = 7 Then
27.
                    rngCurrent.Offset(0, c).NumberFormat = "@"
28.
                    rngCurrent.Offset(0, c).Value = wert
29.
                Else
30.
                    rngCurrent.Offset(0, c).Value = wert
31.
                End If
32.
            Next
33.
            Set rngCurrent = rngCurrent.Offset(1, 0)
34.
        End If
35.
    Next
36.
    Set fso = Nothing
37.
    Set regex = Nothing
38.
End Function
Grüße Uwe
Bitte warten ..
Mitglied: KurinoKi
22.08.2014 um 10:40 Uhr
Hallo Uwe,

vielen Dank für die Aufnahme im Forum und die suuuuuper schnell Antwort.


Ich muss leider nochmals eine Frage zu dem Skript stellen.

Ich verwende das 2. Skript mit der Zusammenfassung am Ende, die mir an sich auch schon reichen würde.

Welche der Zeilen aus diesem Skript muss ich durch die Zeilen 25-31 ersetzten.

Wie muss ich dieses Skript abspeichern, damit ich es als Vorlage immer wieder aufrufen kann. Ich habe das bereits versucht aber dann bringt Excel eine Fehlermeldung, dass das Makro nicht verfügbar ist oder deaktiviert.

Für den Import habe ich mir eine Form in meinem Excel erstellt und das Makro zugewiesen, geht dies auch noch auf einem anderen Weg.

Vielen Dank

Viele Grüße
Stephy
Bitte warten ..
Mitglied: colinardo
22.08.2014, aktualisiert um 10:50 Uhr
Zitat von KurinoKi:
Welche der Zeilen aus diesem Skript muss ich durch die Zeilen 25-31 ersetzten.
wenn du das hier meinst Zeile 49.
Wie muss ich dieses Skript abspeichern, damit ich es als Vorlage immer wieder aufrufen kann. Ich habe das bereits versucht aber
dann bringt Excel eine Fehlermeldung, dass das Makro nicht verfügbar ist oder deaktiviert.
Ein Excelsheet mit Makros musst du im *.xlsm Format abspeichern. Wenn das Makro aber global in allen Arbeitsmappen verfügbar sein soll, musst du es als Addin speichern. Dazu gibst du im "Speichern unter" Dialog als Format Excel Addin *.xlam an. Nach dem Abspeichern gehst du in den Excel-Optionen auf AddIns > Button: Gehe zu "Excel-Addins" und fügst dort dein gerade gespeichertes Addin hinzu und aktivierst es mit einem Häkchen.

Grüße Uwe
Bitte warten ..
Mitglied: KurinoKi
22.08.2014 um 11:56 Uhr
Ich verwende diesese Skript

Sub ImportiereCSVDateien()
Const CSVPFAD = "E:\csv-dateien"
Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, ts As Worksheet
Set fso = CreateObject("Scripting.Filesystemobject")
Set wbTarget = ActiveWorkbook
Application.DisplayAlerts = False
'Lösche alle Worksheets bevor wir alle neu anlegen
While wbTarget.Worksheets.Count > 1
wbTarget.Worksheets(1).Delete
Wend
wbTarget.Worksheets(1).Name = "Zusammenfassung"
wbTarget.Worksheets(1).Range("A:ZZ").Clear
For Each f In fso.GetFolder(CSVPFAD).Files
If LCase(Right(f.Name, 3)) = "csv" Then
Workbooks.OpenText Filename:=f.Path
Set wbSource = ActiveWorkbook
On Error Resume Next
Set ws = wbTarget.Worksheets(f.Name)
If Err <> 0 Then
Set ws = wbTarget.Worksheets.Add
ws.Name = f.Name
ws.Range("A:ZZ").Clear
End If

wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
wbSource.Close False
End If
Next
Set ts = wbTarget.Worksheets("Zusammenfassung")
Dim curCell As Range
Set curCell = ts.Range("A1")
For i = 1 To wbTarget.Worksheets.Count - 1
maxRow = wbTarget.Worksheets(i).Range("A1").End(xlDown).Row
maxCol = wbTarget.Worksheets(i).Range("A1").End(xlToRight).Column
wbTarget.Worksheets(i).Range(wbTarget.Worksheets(i).Cells(1, 1), wbTarget.Worksheets(i).Cells(maxRow, maxCol)).Copy Destination:=curCell
Set curCell = curCell.End(xlDown).Offset(2, 0)
Next
Application.DisplayAlerts = True
Set fso = Nothing
End Sub
Bitte warten ..
Mitglied: Goki44
13.10.2014 um 17:29 Uhr
Hallo IT Freunde,

ich habe das Script getestet und es läuft wunderbar. Vielen Dank an den Ersteller
Gibt es die Möglichkeit in eine zusätzliche Zeile, links dem Datensatz den Dateinamen von der verwendeten csv Datei zu schreiben?

Viele Grüße
Günter
Bitte warten ..
Mitglied: colinardo
13.10.2014, aktualisiert 05.12.2014
Hallo Goki44, Willkommen auf Administrator.de !
Zitat von Goki44:
ich habe das Script getestet und es läuft wunderbar. Vielen Dank an den Ersteller
Keine Ursache
Gibt es die Möglichkeit in eine zusätzliche Zeile, links dem Datensatz den Dateinamen von der verwendeten csv Datei zu
schreiben?
sicher, guckst du hier:
01.
Sub ImportiereCSVDateien()
02.
    Const CSVPFAD = "E:\csvdateien"
03.
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, curCell As Range
04.
    Set fso = CreateObject("Scripting.Filesystemobject")
05.
    Set wbTarget = ThisWorkbook
06.
    Application.DisplayAlerts = False
07.
    Application.ScreenUpdating = False
08.
    'Lösche alle Worksheets bevor wir alle neu anlegen
09.
    While wbTarget.Worksheets.Count > 1
10.
        wbTarget.Worksheets(1).Delete
11.
    Wend
12.
    wbTarget.Worksheets(1).Name = "Zusammenfassung"
13.
    wbTarget.Worksheets(1).Range("A:ZZ").Clear
14.
    For Each f In fso.GetFolder(CSVPFAD).Files
15.
       If LCase(fso.GetExtensionName(f.Name)) = "csv" Then
16.
            Workbooks.OpenText Filename:=f.Path
17.
            Set wbSource = ActiveWorkbook
18.
            On Error Resume Next
19.
            Set ws = wbTarget.Worksheets.Add(After:=wbTarget.Sheets(wbTarget.Sheets.Count))
20.
            ws.Name = f.Name
21.
            ws.Range("A:ZZ").Clear
22.
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
23.
            wbSource.Worksheets(1).UsedRange.Copy Destination:=ws.Range("A1")
24.
            wbSource.Close False
25.
        End If
26.
    Next
27.
    
28.
    With wbTarget.Worksheets("Zusammenfassung")
29.
        Set curCell = .Range("B1")
30.
        For i = 2 To wbTarget.Worksheets.Count
31.
            'Inhalt der CSV in das Zusammenfassungs-Sheet kopieren
32.
            wbTarget.Sheets(i).UsedRange.Copy Destination:=curCell
33.
            'Name der Quelle in Spalte A schreiben
34.
            curCell.Offset(0, -1).Value = wbTarget.Sheets(i).Name
35.
            'Zelle für nächsten Import setzen
36.
            Set curCell = curCell.Offset(wbTarget.Sheets(i).UsedRange.Rows.Count + 2, 0)
37.
        Next
38.
        'Spaltengröße im Zusammenfassungssheet automatisch anpassen
39.
        .UsedRange.EntireColumn.AutoFit
40.
        .Select
41.
    End With
42.
    Application.DisplayAlerts = True
43.
    Application.ScreenUpdating = True
44.
    MsgBox "Vorgang beendet!", vbInformation
45.
    Set fso = Nothing
46.
End Sub
Viel Spaß
Grüße Uwe
Bitte warten ..
Mitglied: Goki44
13.10.2014 um 23:14 Uhr
Vielen Dank für die schnelle Rückmeldung
Bitte warten ..
Mitglied: miregalwie
14.11.2014 um 15:05 Uhr
Wie kann ich dieses Makro (welches übrigens super funktioniert) so modifizieren, dass es mir aus den geöffneten csv-Dateien bestimmte Bereiche (Zelle B5, C12-C14 und G15-G59) kopiert ohne ein Extrablatt in meiner Arbeitmappe anzulegen und im Datenblatt "Zusammenfassung" einfügt. Dabei sollen die Daten aus der 1. csv-Datein in Zeile 1 kopiert werden, die aus der 2. csv-Datei in Zeile 2 usw. Bis es in dem Ordner keine csv-Dateien mehr gibt, d.h. die Anzahl der csv-Dateien ist variabel. Ich versuche schon seit 4 Tagen mein Glück, aber Excel scheint nicht mit mir arbeiten zu wollen.
Bitte warten ..
Mitglied: colinardo
14.11.2014, aktualisiert um 17:30 Uhr
@miregalwie
bitte schaue für deine Anfrage in deine "persönlichen Nachrichten".
Bitte warten ..
Mitglied: waslozzya
05.12.2014, aktualisiert um 16:12 Uhr
Hallo Uwe,

das Makro ist wirklich klasse!
Habe es eingebunden und es erfüllt auch schon fast meine Anforderungen.

Mein Problem ist, dass ich lediglich die "Zusammenfassungs"-Tabelle haben möchte und sonst keine einzelnen Tabellenblätter.
Habe es bisher so geregelt, dass ich einfach an den obigen Code herangehängt habe, dass eben wieder die für mich überflüssigen anderen Tabellenblätter gelöscht werden.
Aus Performance Gründen wäre es natürlich besser, wenn die Tabellenblätter zuvor garnicht erst erstellt werden sondern der Inhalt der CSV-Dateien von Anfang an bloß in das "Zusammenfassungs"-Blatt untereinander hinweg kopiert werden.

Kannst du mir da behilflich sein? Bin mittlerweile schon am verzweifeln, da ich es leider selbst nicht hinbekomme.

Grüße

EDIT: Es handelt sich um folgendes Makro:

01.
 
02.
Sub ImportiereCSVDateien()
03.
    Const CSVPFAD = "E:\csv-dateien"
04.
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, ts As Worksheet
05.
    Set fso = CreateObject("Scripting.Filesystemobject")
06.
    Set wbTarget = ActiveWorkbook
07.
    Application.DisplayAlerts = False
08.
    'Lösche alle Worksheets bevor wir alle neu anlegen
09.
    While wbTarget.Worksheets.Count > 1
10.
            wbTarget.Worksheets(1).Delete
11.
    Wend
12.
    wbTarget.Worksheets(1).Name = "Zusammenfassung"
13.
    wbTarget.Worksheets(1).Range("A:ZZ").Clear
14.
    For Each f In fso.GetFolder(CSVPFAD).Files
15.
        If LCase(Right(f.Name, 3)) = "csv" Then
16.
            Workbooks.OpenText Filename:=f.Path
17.
            Set wbSource = ActiveWorkbook
18.
            On Error Resume Next
19.
            Set ws = wbTarget.Worksheets(f.Name)
20.
            If Err <> 0 Then
21.
                Set ws = wbTarget.Worksheets.Add
22.
                ws.Name = f.Name
23.
                ws.Range("A:ZZ").Clear
24.
            End If
25.
        
26.
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
27.
            wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
28.
            wbSource.Close False
29.
        End If
30.
    Next
31.
    Set ts = wbTarget.Worksheets("Zusammenfassung")
32.
    Dim curCell As Range
33.
    Set curCell = ts.Range("A1")
34.
    For i = 1 To wbTarget.Worksheets.Count - 1
35.
        maxRow = wbTarget.Worksheets(i).Range("A1").End(xlDown).Row
36.
        maxCol = wbTarget.Worksheets(i).Range("A1").End(xlToRight).Column
37.
        wbTarget.Worksheets(i).Range(wbTarget.Worksheets(i).Cells(1, 1), wbTarget.Worksheets(i).Cells(maxRow, maxCol)).Copy Destination:=curCell
38.
        Set curCell = curCell.End(xlDown).Offset(2, 0)
39.
    Next
40.
    Application.DisplayAlerts = True
41.
    Set fso = Nothing
42.
End Sub
43.
 
Bitte warten ..
Mitglied: Schmare
18.11.2015 um 09:10 Uhr
Hallo "colinardo",

ich habe leider noch kaum Kontakt mit Visaul Basic und bin über stundenlange Suche auf diesen älteren Thread gestoßen, der meiner Problemlösung am nächsten kommt. Zum Thema an sich gibt es ja mehrere, die aber immer unterschiedliche Zielformatierungen behandeln.

Hab den Code kopiert aber da ich in meinen csv Dateien zwei Zeilen Überschrift habe, funktioniert es nicht.

Aufgrund meines mangelnden Wissens, schaffe ich es nicht mal den Code so umzuschreiben, dass ich meine csv mit zweizeiliger Überschrift in einer Excel Tabellenblatt zusammenfahren kann.

BESCHREIBUNG DES ABLAUFS
Die erste Datei wird mit dem code incl. der beiden Überschriftszeilen korrekt eingelesen.
Ergebnis: Zwei Überschriften, eine dritte Zeile mit Werten
Bei der Zweite csv wird ohne die erste Überschriftszeile in Tabellenzeile 3 eingelesen und überschreibt somit die Werte aus der ersten csv.
Beim einlesen der dritten csv kommt der Fehler "Anwednungs- oder objektdefinierter Fehler"

Könntest du mir da behilflich sein?




Grüße
Michael
Bitte warten ..
Mitglied: BlackHell
03.12.2015 um 12:00 Uhr
Moin!

Erstmal vielen Dank für das Script.

Zur Sache mit den 2 Headerzeilen habe ich folgenden Vorschlag:

01.
If Counter  <= 2 Then
02.
      Header = True
03.
Else 
04.
      Header = False
05.
End If
In der Funktion importCSV muss dann auch der Zeilenstart angepasst werden.
01.
If ImportHeader Then
02.
      intStart = 0
03.
Else
04.
      intStart = 2
05.
End If
Meine Herausforderung ist eine andere.
Ich wollte bei
01.
arrLines = Split(fso.OpenTextFile(strPath, 1).ReadAll(), vbNewLine, -1, vbTextCompare)
folgende Ergänzung machen, um dort meine ANSI Codierte Datei einlesen zu können, bzw zwischen UTF-8 und ANSI wechseln zu können.
01.
arrLines = Split(fso.OpenTextFile(strPatch, 1, ForReading, TristateFalse).ReadAll(), vbNewLine, -1, vbTextCompare)
Leider klappt das nicht.
Entweder bekomme ich, vermutlich, Chinesische Schriftzeichen, oder ich habe im Text komische Zeichen, wo diese nicht hingehören.

Ich lese mehrere csv Dateien ein. Diese müssen zusammengefasst werden ohne doppelte Header und als eine CSV Datei wieder in einem bestimmten Format und mit einem bestimmten Dateinamen abgespeichert werden. Dann benötige ich die Informationen aus der letzten Spalte, die über eine ZählenWenn Funktion ausgewertet werden und in einem anderen Tabellenblatt immer als Zeile 2 eingefügt werden sollen. Die schon vorhandenen sollen dann jeweils nach unten verschoben werden.

Da ich hier nur das 2003er Office habe, bin ich auf die vorhandenen Möglichkeiten beschränkt.

BlackHell
Bitte warten ..
Mitglied: superspacer-2000
10.01.2016 um 17:18 Uhr
Hallo Uwe,

ich habe das obige Script ausprobiert und es importiert auch die Daten.

Aber dann erscheint "Laufzeitfehler 1004" und die Zeile 20 ist gelb unterlegt.

Gibt es dafür eine Lösung?

Danke schon mal im Voraus, ich bin eher Laie, was Makros angeht.

Gruß

Steffen
Bitte warten ..
Mitglied: interface31
15.08.2016 um 09:49 Uhr
Hi Uwe,

habe dein Code mal angewendet.
Habe eine Vorlage mit drei Sheets.
Mein Problem ist das, das ein neues Sheet angelegt wird und es nicht in das Daten Sheet eingefügt wird.
Dazu soll zu jedem CSV File ein eigenes File erzeugt werden zu der Vorlage.


01.
Sub ImportiereCSVDateien()
02.
    Const CSVPFAD = "C:\Z_Test\"
03.
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet
04.
    Set fso = CreateObject("Scripting.Filesystemobject")
05.
    Set wbTarget = ActiveWorkbook
06.
    Application.DisplayAlerts = False
07.
    'Lösche alle Worksheets bevor wir alle neu anlegen
08.
    'If wbTarget.Worksheets.Count > 1 Then
09.
        'For i = 1 To wbTarget.Worksheets.Count - 1
10.
       '     wbTarget.Worksheets(i).Delete
11.
      '  Next
12.
    'End If
13.
    For Each f In fso.GetFolder(CSVPFAD).Files
14.
        If LCase(Right(f.Name, 3)) = "csv" Then
15.
            Workbooks.OpenText Filename:=f.Path
16.
            Set wbSource = ActiveWorkbook
17.
            On Error Resume Next
18.
            Set ws = wbTarget.Worksheets(f.Name)
19.
            If Err <> 0 Then
20.
                Set ws = wbTarget.Worksheets.Add
21.
                ws.Name = f.Name
22.
                ws.Range("A:ZZ").Clear
23.
            End If
24.
        
25.
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
26.
            wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")
27.
            wbSource.Close False
28.
        End If
29.
    Next
30.
    Application.DisplayAlerts = True
31.
    Set fso = Nothing
32.
End Sub
33.
 
Bitte warten ..
Mitglied: colinardo
15.08.2016, aktualisiert um 11:30 Uhr
Hi,
ist ja auch logisch denn der obige Code erstellt für jede CSV Datei ein neues Sheet, der macht nichts anderes...!
Die anderen Varianten, ob untereinander in einem Sheet zusammengefasst oder nebeneinander etc. pp ... Findest du von mir schon hier im Forum bis zum Abwinken :

Grüße Uwe
Bitte warten ..
Mitglied: interface31
19.08.2016 um 15:36 Uhr
Ok gut aber wie bekomme ich es hin das in meiner Vorlage das einzelne CSV eingelesen werden kann?

01.
Sub ImportCSVFromFolder()
02.
    Dim wsTemp As Worksheet, wsTarget As Worksheet, curCell As Range, CSVPFAD As String, fso As Object, f As Object, strCSVDelimiter As String
03.
    
04.
    With Application.FileDialog(msoFileDialogFolderPicker)
05.
        .InitialFileName = "C:\Z_Test\M176"
06.
        .Title = "Ordnerauswahl"
07.
        .ButtonName = "Auswahl..."
08.
        .InitialView = msoFileDialogViewList
09.
        If .Show = -1 Then
10.
            CSVPFAD = .SelectedItems(1)
11.
        Else
12.
            Exit Sub
13.
        End If
14.
    End With
15.
    
16.
    'Legt das CSV-Trennzeichen für die Dateien fest
17.
    strCSVDelimiter = ";"
18.
    
19.
    Set fso = CreateObject("Scripting.Filesystemobject")
20.
    Application.DisplayAlerts = False
21.
    Application.ScreenUpdating = False
22.
    
23.
    'Zielarbeitsblatt für die importierten Daten
24.
    Set wsTarget = Worksheets(1)
25.
    wsTarget.Name = "Zusammenfassung"
26.
    'temporäres Arbeitsblatt für den Import der Daten erstellen
27.
    Set wsTemp = Worksheets.Add(After:=Worksheets(Worksheets.Count))
28.
    
29.
    'Inhalt des Zusammenfassungsblattes löschen
30.
    wsTarget.UsedRange.Clear
31.
    
32.
    'Startausgabezelle festlegen
33.
    Set curCell = wsTarget.Range("A1")
34.
    For Each f In fso.GetFolder(CSVPFAD).Files
35.
        If LCase(fso.GetExtensionName(f.Name)) = "csv" Then
36.
            'Temporäres Sheet löschen
37.
            wsTemp.UsedRange.Clear
38.
            'CSV-Daten in Temporäres Sheet importieren
39.
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & f.Path, Destination:=wsTemp.Range("$A$1"))
40.
                .Name = "import"
41.
                .FieldNames = True
42.
                .AdjustColumnWidth = True
43.
                .RefreshPeriod = 0
44.
                .TextFilePlatform = xlWindows
45.
                .TextFileStartRow = 1
46.
                .TextFileParseType = xlDelimited
47.
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
48.
                .TextFileOtherDelimiter = strCSVDelimiter
49.
                .Refresh BackgroundQuery:=False
50.
                .Delete
51.
            End With
52.
            
53.
            With wsTemp
54.
                'Daten in Zielsheet kopieren
55.
                .UsedRange.Copy curCell
56.
            End With
57.
            'Ausgabezeile eins nach unten schieben
58.
            Set curCell = wsTarget.Cells(wsTarget.UsedRange.Rows.Count + 2, 1)
59.
        End If
60.
    Next
61.
    'Temporäres Sheet löschen
62.
    wsTemp.Delete
63.
    'Spalten anpassen
64.
    wsTarget.Columns.AutoFit
65.
    
66.
    Application.DisplayAlerts = True
67.
    Application.ScreenUpdating = True
68.
    MsgBox "Vorgang beendet!", vbInformation
69.
    Set fso = Nothing
70.
End Sub
Mit diesem Coden bekomme ich alle in ein Excelfile was auch ok wäre aber anderen Aufbau dann nach sich zieht
Bitte warten ..
Mitglied: colinardo
19.08.2016, aktualisiert um 16:13 Uhr
Zitat von interface31:
Ok gut aber wie bekomme ich es hin das in meiner Vorlage das einzelne CSV eingelesen werden kann?
Indem du den "FolderPicker" durch einen msoFileDialogOpen ersetzt und die Schleife durch eine Itteration über die Dialogauswahl ersetzt

01.
Sub ImportCSVFromFiles()
02.
    Dim wsTemp As Worksheet, wsTarget As Worksheet, curCell As Range, CSVFILES As Object, strCSVDelimiter As String
03.
    
04.
    With Application.FileDialog(msoFileDialogOpen)
05.
        .Title = "CSV-Dateien wählen"
06.
        .ButtonName = "Auswahl..."
07.
        .InitialView = msoFileDialogViewList
08.
        .Filters.Add "CSV-Dateien", "*.csv", 1
09.
        .AllowMultiSelect = True
10.
        If .Show = -1 Then
11.
            Set CSVFILES = .SelectedItems
12.
        Else
13.
            Exit Sub
14.
        End If
15.
    End With
16.
    
17.
    
18.
    'Legt das CSV-Trennzeichen für die Dateien fest
19.
    strCSVDelimiter = ";"
20.
    
21.
    Application.DisplayAlerts = False
22.
    Application.ScreenUpdating = False
23.
    
24.
    'Zielarbeitsblatt für die importierten Daten
25.
    Set wsTarget = Worksheets(1)
26.
    wsTarget.Name = "Zusammenfassung"
27.
    'temporäres Arbeitsblatt für den Import der Daten erstellen
28.
    Set wsTemp = Worksheets.Add(After:=Worksheets(Worksheets.Count))
29.
    
30.
    'Inhalt des Zusammenfassungsblattes löschen
31.
    wsTarget.UsedRange.Clear
32.
    
33.
    'Startausgabezelle festlegen
34.
    Set curCell = wsTarget.Range("A1")
35.
    For i = 1 To CSVFILES.Count
36.
 
37.
        'Temporäres Sheet löschen
38.
        wsTemp.UsedRange.Clear
39.
        'CSV-Daten in Temporäres Sheet importieren
40.
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & CSVFILES.Item(i), Destination:=wsTemp.Range("$A$1"))
41.
            .Name = "import"
42.
            .FieldNames = True
43.
            .AdjustColumnWidth = True
44.
            .RefreshPeriod = 0
45.
            .TextFilePlatform = xlWindows
46.
            .TextFileStartRow = 1
47.
            .TextFileParseType = xlDelimited
48.
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
49.
            .TextFileOtherDelimiter = strCSVDelimiter
50.
            .Refresh BackgroundQuery:=False
51.
            .Delete
52.
        End With
53.
        
54.
        'Daten in Zielsheet kopieren
55.
        wsTemp.UsedRange.Copy curCell
56.
        
57.
        'Ausgabezeile eins nach unten schieben
58.
        Set curCell = wsTarget.Cells(wsTarget.UsedRange.Rows.Count + 2, 1)
59.
    Next
60.
    'Temporäres Sheet löschen
61.
    wsTemp.Delete
62.
    'Spalten anpassen
63.
    wsTarget.Columns.AutoFit
64.
    
65.
    Application.DisplayAlerts = True
66.
    Application.ScreenUpdating = True
67.
    MsgBox "Vorgang beendet!", vbInformation
68.
End Sub
Bitte warten ..
Mitglied: interface31
23.08.2016 um 15:10 Uhr
Danke klappt soweit.
Bekomme ich das aber auch automatisiert, so dass ich sage öffne die 100 csv files und speichere sie mit der Vorlage neu ab unter den Namen vom Sheet 1 Celle A1?
Bitte warten ..
Mitglied: colinardo
23.08.2016, aktualisiert um 18:09 Uhr
Öhm willst du mich jetzt veräppeln ?? Die vorherige Variante hat doch schon automatisch alle Files eines Ordners verarbeitet. Machen kann ich alles, aber das ist hier ja kein Wunschkonzert! Wenn du eine individuelle Anpassung brauchst kannst du mich gerne per PM kontaktieren und in mache dir dann ein Angebot dazu.
Wenn du das nicht willst, Code hast du jetzt eigentlich zur Genüge um das auch selbst zu realisieren.

p.s. Das Übernehmen von Fragen ist hier eigentlich nicht gern gesehen.
Bitte warten ..
Mitglied: Biber
23.08.2016 um 19:39 Uhr
[OT]

Zitat von colinardo:

p.s. Das übernehmen von Fragen ist hier eigentlich nicht gern gesehen.
Und es kostet auch meist mehrere Anläufe, bis es zum Übelnehmen von Fragen kommt.

Grüße
Biber

P.S. Aber bevor es hier lauter wird:
Ich denke, es stehen hier jetzt auch für einen Einsteiger genug Ansätze, um die gewünschte Variation in endlicher Zeit und einem Minimum an Koffein oder anderen Drogen ins Ziel zu bringen. Büschen mehr Mut, interface31. Wenn es garnienich klappt, melde dich nochmal. Ansonsten würde ich den TO-losen Beitrag gerne schliessen.

[/OT]
Bitte warten ..
Mitglied: JoSiBa
15.09.2016, aktualisiert um 11:34 Uhr
Hallo Colinardo,

ich benutze diese Version deines Codes:
01.
Sub ImportiereCSVDateien()
02.
    Dim ws As Worksheet, header As Boolean, startRange As Range, curRange As Range, counter As Integer
03.
    Const CSVPFAD = "E:\Datenbank"
04.
    Set fso = CreateObject("Scripting.Filesystemobject")
05.
    Set ws = Worksheets(1)
06.
    ws.Range("A:ZZ").Clear
07.
    Set startRange = ws.Range("A1")
08.
    Set curRange = startRange
09.
    Application.DisplayAlerts = False
10.
    counter = 1
11.
    For Each f In fso.GetFolder(CSVPFAD).Files
12.
        If LCase(Right(f.Name, 3)) = "csv" Then
13.
            Dim importHeader As Boolean
14.
            If counter = 1 Then
15.
                header = True
16.
            Else
17.
                header = False
18.
            End If
19.
            importCSV f.Path, ";", curRange, header
20.
            Set curRange = curRange.End(xlDown).Offset(1, 0)
21.
            counter = counter + 1
22.
        End If
23.
        
24.
    Next
25.
    ws.ListObjects.Add xlSrcRange, ws.Range(startRange, curRange.Offset(-1, curRange.Offset(-1, 0).End(xlToRight).Column - 1))
26.
    Application.DisplayAlerts = True
27.
    Set fso = Nothing
28.
End Sub
29.
 
30.
Function importCSV(strPath, delim, ByVal targetRange As Range, ByVal importHeader As Boolean)
31.
    Dim intStart As Integer
32.
    Set fso = CreateObject("Scripting.FileSystemObject")
33.
    Set regex = CreateObject("vbscript.regexp")
34.
    patNumber = "^([\d\.,\+\-]+)$"
35.
    arrLines = Split(fso.OpenTextFile(strPath, 1).ReadAll(), vbNewLine, -1, vbTextCompare)
36.
    Set rngCurrent = targetRange
37.
    If importHeader Then
38.
        intStart = 0
39.
    Else
40.
        intStart = 1
41.
    End If
42.
    For i = intStart To UBound(arrLines)
43.
        If arrLines(i) <> "" Then
44.
            cols = Split(arrLines(i), delim, -1, vbTextCompare)
45.
            For c = 0 To UBound(cols)
46.
                rngCurrent.Offset(0, c).ClearFormats
47.
                wert = Trim(Replace(cols(c), """", "", 1, -1, vbTextCompare))
48.
                ' check for Numberformat
49.
                regex.Pattern = patNumber
50.
                Set matches = regex.Execute(wert)
51.
                If matches.Count > 0 Then
52.
                    wert = Replace(matches(0).Submatches(0), ",", ".", 1, -1, vbTextCompare)
53.
                End If
54.
                ' set value in cell
55.
                rngCurrent.Offset(0, c).Value = wert
56.
            Next
57.
            Set rngCurrent = rngCurrent.Offset(1, 0)
58.
        End If
59.
    Next
60.
    Set fso = Nothing
61.
    Set regex = Nothing
62.
End Function
Die Importierung an sich Funktioniert.

Ich habe hier nur 4 Anliegen.

1) Die Datenbank wird im mom auf "Worksheets(1)" eingelesen, ist es möglich das es immer in den "Tabellenblatt : Datenbank)" eingelesen wird, egal ob es das 2,3,4 Tabellenblatt ist.

2) Datenbank Tabellenname wird als "Tabelle3" eingetragen, ist es möglich diese zu Ändern in "Master_DB".

3) Noch eine Frage, beim Importieren, werden nur die Spalten A:L als Datenbank eingelesen, die restlichen M:AG werden nicht mehr als Datenbank sonder als normale Tabelle.

4) In den Spalten "D:E" sind Datum und Uhrzeit als "UNIX Timestamp" vorhanden, diese sollen beim Importieren in den Format (DD.MM.JJJJ HH:MM) umgewandelt werden.
Was muss im Code geändert werden? Kannst du mir hier helfen?
Bitte warten ..
Mitglied: JoKa0804
02.11.2016 um 16:04 Uhr
Hallo und HILFÄ!
ich bin ein absoluter Laie! Das VBA von Colinardo 29.08.2013 um 11:49 Uhr (CSV importieren und eine Zusammenfassungsseite) ist klasse, funktioniert bei mir leider nicht vollständig. In den CSV-Dateien, die ich benutze ist eigentlich alles nach Spalten ordentlich aufgeteilt (keine Trennung nach Semikolon). In Spalte "L" stehen allerdings Beträge (mit Komma). Das VBA befüllt ab dem Komma des Betrages und die Nachkommastellen nicht mehr und auch jede Spalte danach ist leer. Kann mit bitte jemand helfen? Ich brauche dafür bitte das vollständige VBA (Fragmente helfen mir leider nicht)
Danke!!!!!
Bitte warten ..
Mitglied: Lange44227
09.03.2017 um 14:42 Uhr
Hallo colinardo,

ich habe eine .CSV Datei, in der ebenfalls Kommas vorkommen in den Messwerten. Wie kann ich verhindern, dass durch
01.
Set wbSource = ActiveWorkbook
schon an dem Komma die Werte in einzelne Spalten getrennt werden?

20160101_250742;12872,9;780;678;6853;2,81;14;15,1;14,4;14,1;15;15,8

Dies Werte werden dann schon zu:
20160101_250742;12872 || 9;780;678;6853;2 || 81;14;15 || 1;14 || 4;14 || 1;15;15 || 8
Dadurch werden mit
01.
wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True
meine Messwerte teilweise gelöscht
Bitte warten ..
Mitglied: colinardo
09.03.2017, aktualisiert um 15:06 Uhr
Zeile 15
01.
Workbooks.OpenText Filename:=f.Path, DataType:=xlFixedWidth
Grüße Uwe
Bitte warten ..
Mitglied: Lange44227
10.03.2017 um 07:19 Uhr
Danke für die schnelle Antwort, allerdings werden die Werte immer noch am Komma getrennt und in einzelne Spalten geschrieben. Ich denke es würde helfen, wenn VBA beim Öffnen der .CSV die Kommas einfach ignoriert.
Bitte warten ..
Mitglied: colinardo
10.03.2017, aktualisiert um 07:38 Uhr
Geht hier einwandfrei. Hier wird nichts automatisch am Komma getrennt!
Du kannst zwar noch versuchen in der TextToColumns Zeile den Parameter Comma:=false festzulegen, aber das ist der Defaultwert. Zusätzlich kannst du den Parameter für den DecimalSeparator definieren wenn dieser von Standard in den Regionseinstellungen abweicht.
Ansonsten liegt es an der Kodierung deiner Dateien.
Siehe dazu den Origin Parameter
https://msdn.microsoft.com/de-de/library/office/ff837097.aspx

Weiteres bitte nur per PN. Danke!
Bitte warten ..
Mitglied: colinardo
10.03.2017, aktualisiert um 07:58 Uhr
Und an alle die hier vorbei kommen noch folgender Hinweis
Hier:
https://www.administrator.de/forum/excel-makro-csv-dateien-auszuwerten-g ...
gibt es mittlerweile aktuelleren Code von mir. Der von oben ist sagen wir es mal so, schon etwas angestaubt.

Weitere Anpassungswünsche dann bitte nur noch per PN. Merci!

Thread von meiner Seite aus geschlossen.
Bitte warten ..
Ähnliche Inhalte
Microsoft Office

CSV-Datei mit einem VBA Makro in Excel einlesen und leicht anpassen

gelöst Frage von JoSiBaMicrosoft Office5 Kommentare

Hallo zusammen, ich benutze folgenden Code von Colinardo: Die Importierung an sich Funktioniert. Ich habe hier nur 4 Anliegen. ...

Microsoft Office

Csv datei vba makro excel einlesen leicht anpassen - eventuell noch eine Erweiterung

Frage von mrniceguy1977Microsoft Office2 Kommentare

Hallo Zusammen, bin neu bei euch und durch die Suche nach einem CSV Importer auf diese Seite gestossen. Den ...

VB for Applications

Mehrere CSV-Dateien mit einem VBA Makro einlesen und automatisch verarbeiten

Frage von armini92VB for Applications3 Kommentare

Hallo! Ich schreibe gerade meine Bachelorarbeit und bekomme täglich zahlreiche Messergebnisse im CSV-Format ausgegeben. Diese muss ich manuell konvertieren, ...

VB for Applications

VBA-Makro verschwindet nach Speichern

gelöst Frage von lupi1989VB for Applications5 Kommentare

Liebe Leute, bei mir verschwindet der Makro für den Scrollbereich in Excel(abgespeichert in xlsm) immer wieder nach dem Speichern. ...

Neue Wissensbeiträge
iOS
WatchChat für Whatsapp
Tipp von Criemo vor 2 TageniOS3 Kommentare

Ziemlich coole App für WhatsApp User in Verbindung mit der Apple Watch. Gibts für iOS sowohl als auch für ...

iOS
IOS hat nen Cursor !!!
Tipp von Criemo vor 2 TageniOS5 Kommentare

Nette Funktion im iOS. iPhone-Mauszeiger aktivieren „Nichts ist nerviger, als bei einem Tippfehler zu versuchen, den iOS-Cursor an die ...

Off Topic
Avengers 4: Endgame - Erster Trailer
Information von Frank vor 4 TagenOff Topic2 Kommentare

Ich weiß es ist Off Topic, aber ich freue mich auf diesen Film und vielleicht geht es anderen hier ...

Webbrowser
Microsoft bestätigt Edge mit Chromium-Kern
Information von Frank vor 5 TagenWebbrowser5 Kommentare

Microsoft hat nun in seinem Blog bestätigt, dass die nächste Edge Version kein EdgeHTML mehr für die Darstellung benutzen ...

Heiß diskutierte Inhalte
Windows Netzwerk
Kerio. Kann keine Mails empfangen aber senden. Wer ist schuld. Kerio oder Windows domäne?
gelöst Frage von frosch2Windows Netzwerk33 Kommentare

Hallo, es existiert ein Problem bei uns mit dem mailen. Alle bestehenden Nutzer können mailen. Raus wie rein. Neuen ...

Hosting & Housing
VMware VM mit über 1TB RAM für S4HANA
gelöst Frage von Leo-leHosting & Housing24 Kommentare

Hallo zusammen, wer hat Erfahrng und kann mir einen Tipp zum sizing von S4HANA Systemen geben? Wir möchten, zunächst ...

LAN, WAN, Wireless
WLAN und Ausmessung - Eine Glaubensfrage?
Frage von ptr2brainLAN, WAN, Wireless23 Kommentare

Liebe Experten, als Sys-Admin habe ich mir schon öfter die Frage gestellt, ob es sich beim Thema WLAN und ...

Virtualisierung
Gebrauchte Server Hardware als Virtualisierungs-"Spielwiese"?
Frage von NixVerstehenVirtualisierung19 Kommentare

Einen wunderschönen guten Morgen zusammen, ich möchte mich gerne etwas tiefer mit dem Thema Virtualisierung beschäftigen und dazu ein ...