Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1328to1332
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
CSV Import mit VBA
29.08.2013 14:36:27
Hendrik
Hallo liebe Herber Gemeinde,
ich bin zur Zeit auf der Suche nach einer Lösung für den Import von 8760 CSV Dateien in eine einzelne Excel Datei.
Als Ansatz habe ich hier im Forumsarchiv von "Horst" folgenden Code gefunden und konnten diesen an meine Bedürfnisse soweit anpassen, dass das Makro das erledigt, was es soll :-)
Das Problem ist nur, dass beim Excel beim einlesen jeder einzelnen Datei verlangt, dass ich das Löschen der Zwischenablage bestätige.
Ich hatte bereits versucht durch das Einfügen des Befehls
application.cutcopymode = false 
dies zu unterbinden, jedoch leider ohne Erfolg ...
Wenn es nur ein paar Dateien wären, wäre diese Meldung ja nicht weiter schlimm, aber 8760 mal den Button zu klicken geht dann doch an die Geduldsgrenze ;-)
Sub CSV_Dateien_importieren()
' Daten aus CSV-Dateien einfügen, Daten sind durch Semicolon getrennt, _
Dezimalstelle ist Punkt
' im aktiven Blatt werden Daten aus CSV Dateien im gewählten Verzeichnis eingefügt
Dim wb As Workbook, wks As Worksheet, wbAktiv As Workbook, wksAktiv As Worksheet
Dim rngZelle As Range
Dim strVerzeichnis As String
Dim Dateiname As Variant, DateinameTXT As String
Const strZelleDatum As String = "A2" 'Zelle mit Datum in CSV-Datei
Const strBereich As String = "A2:B97" 'zu kopierender Bereich in CSV-Datei
Const lngZeilenBereich As Long = 96 'Anzahl Zeilen des kopierten Bereichs in CSV-datei
Dateiname = Application.GetOpenFilename(FileFilter:="CSV (*.csv), *.csv", _
Title:="CSV-Datei im Verzeichnis auswählen")
If Dateiname = False Then Exit Sub
strVerzeichnis = VBA.CurDir
Set wbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
'Nächste freie Zelle in Spalte B (2) am Ende suchen
Set rngZelle = wksAktiv.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Dateiname = Dir(strVerzeichnis & Application.PathSeparator & "*.csv")
Application.ScreenUpdating = False
Do Until Dateiname = ""
'CSV-Datei temporär als txt-Datei kopieren
VBA.FileCopy Source:=Dateiname, Destination:=Left(Dateiname, Len(Dateiname) - 3) & "txt"
DateinameTXT = Left(Dateiname, Len(Dateiname) - 3) & "txt"
'Umbenannte Kopie öffnen
Application.Workbooks.OpenText Filename:=DateinameTXT, Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False, _
DecimalSeparator:=".", ThousandsSeparator:=","
Set wb = ActiveWorkbook
'Daten Kopieren
wb.Sheets(1).Range(strBereich).Copy
rngZelle.PasteSpecial Paste:=xlPasteValues
'Datum aus CSV-Datei in Spalte links von den Daten einfügen
wksAktiv.Range(rngZelle.Offset(0, -1), rngZelle.Offset(lngZeilenBereich - 1, -1)).Value _
= wb.Sheets(1).Range(strZelleDatum)
'Nächste Einfügezelle setzen
Set rngZelle = rngZelle.Offset(lngZeilenBereich, 0)
wb.Close savechanges:=False
'TXT-Kopie wieder löschen
VBA.Kill (DateinameTXT)
Dateiname = Dir
Loop
Application.ScreenUpdating = True
End Sub
Für jede Hilfe wäre ich sehr dankbar :)
Beste Grüße!

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: CSV Import mit VBA
29.08.2013 14:42:00
Ben
Hallo Hendrik,
was ist denn, wenn Du die "Meldung" ausschaltest:
Application.DisplayAlerts = False
Gruß, Ben
Anzeige

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige