Bestimmte CSV-Dateien in Arbeitsmappe importieren

Hallo,
Ich bin VBA-Anfänger und bräuchte einmal eure Hilfe. Von einem Wegmessprogramm wird je Messung eine Reihe von CSV-Dateien erzeugt, die in einem Oberverzeichnis für die jeweilige Messung abgelegt wird. Von diesen Dateien werden stets die vier gleichen zur Auswertung herangezogen, d.h. sie sollen nacheinander in eine Arbeitsmappe auf eine Seite je CSV-Datei importiert werden. Dabei soll die Seite nach der CSV-Datei umbenannt werden, aus der ihre Daten stammen.
Meine Fragen wären daher:
1. Ist es möglich ohne irgendwelche Zusatz-Programme meinen Code so umzuschreiben, dass ich nur das Verzeichnis auswählen muss und von dort werden direkt die vier CSV-Dateien(Messdatei1, Messdatei2, Messdatei3, Messdatei4) in meine Mappe importiert? Gleichzeitig wäre es optimal, wenn diese Dateien jeweils auf einem eigenen Tabellenblatt landen, was das ganze nicht wirklich einfacher macht... Wenn ja, wie wäre das umzusetzen? (Habe bereits einige Stunden gegoogelt)
2. Wie bekomme ich es hin, dass in meiner Arbeitsmappe die Seiten nach der jeweiligen CSV-Datei benannt werden?
Danke schonmal im Voraus für jegliche Hilfen!
PS: Der Kern des Programms ist eine automatische Auswertung der Messergebnisse, die sich dann in einer zentralen Mappe befinden. Diesen Teil habe ich soweit schon fertig gestellt, ich habe auch schon ein Code-Stück zum importieren einer CSV-Datei gefunden, das soweit bei mir funktioniert:

Sub ImportCSVFile()
Dim xFileName As Variant
Dim Rg As Range
Dim xAddress As String
xFileName = Application.GetOpenFilename("CSV File (*.csv), *.csv", , "Kutools for Excel", ,  _
False)
If xFileName = False Then Exit Sub
On Error Resume Next
Set Rg = Application.InputBox("please select a cell to output the data", "Kutools for Excel" _
, Application.ActiveCell.Address, , , , , 8)
On Error GoTo 0
If Rg Is Nothing Then Exit Sub
xAddress = Rg.Address
With ActiveSheet.QueryTables.Add("TEXT;" & xFileName, Range(xAddress))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

Hallo Lukas,
wenn du die Blätter vorhab anlegen möchtes, dann sollte der ganze Aufbau der Makros etwas umstrukturiert werden.
1. Namen der zu importierenden Blätter in Array schreiben,
2. Verzeichnis mit Reihen-Dateien auswählen
3. Prüfen, ob die CSV-Dateien vorhanden sind
4. Blätter anlegen, dabei prüfen, ob Blatt mit Name schon vorhanden.
5. CSV-Import starten
Ich hab das Makro von Rudi getestet. gleiches Prüblem wie bei dir.
Ich hab es angepasst, so dass der Import korrekt erfolgt.
Ich hab auch dein ursprüngliches Import-Makro angepasst damit der Import in ein deutsches (Systemeinstellungen) Excel korrekt funktioniert. Dies betrifft das Dezimalzeichen (in CSV-Datei "." und die Wahrheitswerte TRUE/WAHR und FALSE/FALSCH.
LG
Franz

'erstellt und getestet unter Excel 2010
Sub Neue_Tabellenblaetter()
Dim wkb As Workbook, wks As Object
Dim wsNew As Worksheet
Dim vntDatei, vntDateien, strPfad As String, sBlattName As String
'Namen der CSV-Dateien, die importiert werden sollen in Array schreiben
vntDateien = Array("C2-Sample_Meas_DAC_DIE1.csv", _
"C2-Sample_Meas_DAC_DIE2.csv", _
"C2-Sample_MeasPost_DAC_DIE1.csv", _
"C2-Sample_MeasPost_DAC_DIE2.csv")
Set wkb = ActiveWorkbook
'Verzeichnis/Ordner mit den Dateien der Messreihe auswählen
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\Users\Public\Test\Messdaten"  'Startordner für Auswahl -  _
anpassen !!!
.Title = "Bitte Ordner mit Messreihe auswählen - Kutools for Excel"
If .Show = -1 Then
strPfad = .SelectedItems(1) & Application.PathSeparator
Else
GoTo Beenden
End If
End With
'Prüfen, ob Dateien im gewählten Verzeichnis vorhanden sind
For Each vntDatei In vntDateien
If Dir(strPfad & vntDatei) = "" Then
MsgBox "Datei: " & vntDatei & vbLf _
& "ist im Verzeichnis" & vbLf & strPfad & vbLf & "nicht vorhanden! Makro wird  _
abgebrochen", _
vbInformation + vbOKOnly, "Prüfung ob csv-Datei existiert - Kutools for Excel"
GoTo Beenden
End If
Next
With wkb
'Blätter anlegen - Blätter können auch beliebig andere Namen bekommen
For Each vntDatei In vntDateien
sBlattName = Left(vntDatei, Len(vntDatei) - 4)
'Prüfen, ob Blattname in Mappe schon vorhanden
If fncCheckBlattname(strName:=sBlattName, wkb:=ActiveWorkbook) Then
MsgBox "Blatt: " & sBlattName & vbLf _
& "ist in der Datei schon vorhanden. Makro wird abgebrochen", _
vbInformation + vbOKOnly, "Prüfen Blattnamen - Kutools for Excel"
GoTo Beenden
Else
Set wsNew = Worksheets.Add(after:=.Sheets(.Sheets.Count))
wsNew.Name = sBlattName
End If
Next
End With
Call ImportCSVFile_Lukas(strPfad, vntDateien, sEinfuegeZelle:="A2")
'    Call CSV_Import_Rudi_modifiziert(strPfad, vntDateien, sEinfuegeZelle:="A2")
Beenden:
End Sub
Function fncCheckBlattname(ByVal strName, Optional wkb As Workbook) As Boolean
'Funktion prüft, ob ein Blatt mit dem Namen in der Arbeitsmappe vorhanden ist
Dim objSheet As Object
On Error GoTo Fehler
If wkb Is Nothing Then Set wkb = ActiveWorkbook
Set objSheet = wkb.Sheets(strName)
fncCheckBlattname = True
Fehler:
End Function
Sub CSV_Import_Rudi_modifiziert(strPfad As String, vntDateien, Optional ByVal sEinfuegeZelle As  _
String = "A1")
Dim vROH, arrDaten(), vTMP, i As Long, j As Long
Dim vntDatei, iSheet As Integer
Const cstrDELIM As String = ";" 'Trennzeichen
iSheet = UBound(vntDateien) + 1
If Right(strPfad, 1)  "\" Then strPfad = strPfad & "\"
For Each vntDatei In vntDateien
Open strPfad & vntDatei For Input As #1  'Dateiname anpassen
vROH = Input(LOF(1), 1)
Close #1
vROH = Split(Replace(vROH, Chr(13), ""), Chr(10)) 'Ohne das Zeichen zu ersetzen wird  _
alles in eine Zeile geschrieben
ReDim arrDaten(UBound(vROH), UBound(Split(vROH(LBound(vROH)), cstrDELIM)))
For i = LBound(vROH) To UBound(vROH)
vTMP = Split(vROH(i), cstrDELIM)
For j = LBound(vTMP) To UBound(vTMP)
arrDaten(i, j) = vTMP(j)
Next
Next
iSheet = iSheet - 1
With ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count - iSheet)
.Range(sEinfuegeZelle).Resize(UBound(arrDaten) + 1, UBound(arrDaten, 2) + 1) = arrDaten
End With
Next vntDatei
End Sub
Sub ImportCSVFile_Lukas(strPfad As String, vntDateien, Optional ByVal sEinfuegeZelle As String = _
"A1")
Dim xFileName As Variant
Dim rngEinfuegen As Range
Dim wks As Worksheet
Dim vntDatei, iSheet As Integer
iSheet = UBound(vntDateien) + 1 '=Anzahl der zu importierenden CSV-Dateien
For Each vntDatei In vntDateien
xFileName = strPfad & vntDatei
With ActiveWorkbook
iSheet = iSheet - 1
Set wks = .Sheets(.Sheets.Count - iSheet)
End With
Set rngEinfuegen = wks.Range(sEinfuegeZelle)
With wks.QueryTables.Add("TEXT;" & xFileName, rngEinfuegen)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 936     '?
'            .TextFilePlatform = 1252 'ANSI Windows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = ","
.Refresh BackgroundQuery:=False
End With
With wks
'Angelegte Daten-Verbindung der Querry wieder löschen
.QueryTables(1).WorkbookConnection.Delete
With .UsedRange
.Replace What:="TRUE", Replacement:="WAHR", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Replace What:="FALSE", Replacement:="FALSCH", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.EntireColumn.AutoFit
End With
End With
Next vntDatei
End Sub

Bestimmte CSV-Dateien in Arbeitsmappe importieren

Forumthread: Bestimmte CSV-Dateien in Arbeitsmappe importieren

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Bestimmte CSV-Dateien in Arbeitsmappe importieren

Forumthread: Bestimmte CSV-Dateien in Arbeitsmappe importieren

20 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

20
Beiträge zum Forumthread

Beiträge zu diesem Forumthread