.csv Datei als Text importieren
16.08.2018 13:49:54
Charlotte
ich bin grad auf der Suche nach der Lösung für mein Problem.
Es ist wahrscheinlich relativ simpel.
Ich muss mehrere .csv-Dateien importieren. Code dafür steht auch und funktioniert super.
Einziges Problem ist das Textformat. Ich hab so blöde Zahlen, wie 24.2 drin, die Excel natürlich (was soll es auch sonst sein) zum 24. Februar macht.
Kann ich in dem Code etwas hinzufügen, dass die .csv direkt als Text importiert?
Genau dies hat sonst per Hand immer geholfen.
Sub Rename_Files()
'(C) Ramses
'Liest alle CSV-Dateien in einem Verzeichnis ein
Dim Datei As String, freeCol As Long
Dim Qe As Integer
Dim PFAD As String
PFAD = "Y:\ATB\00_Friedrichs\SKT\GOM CSV Dateien\" '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 ""
If Cells(2, Columns.Count).End(xlToLeft).Column = 1 Then
freeCol = 1
Else
freeCol = Cells(2, Columns.Count).End(xlToLeft).Column + 1
End If
Cells(1, freeCol) = Datei
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & PFAD & Datei, Destination:=Cells(2, _
freeCol))
.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
Schonmal vielen vielen Dank für Antworten.