AW: Import einer per VBA-Code manuell ausgewählten .csv-Datei
03.09.2024 20:07:45
ralf_b
ich habe mir aus dem Archivthread nur den Code angesehen. Die CSV-Dateien aber nicht.
die Integration des Dateinamens sollte funktionieren.
Sub CSV_Importieren()
'==========================
'... vorgelagerter Code ...
'==========================
'Speicherung der zuvor erzeugten Datei
'ActiveWorkbook.SaveAs Filename:="M:\Users\JohnDoe\Documents\Weiterer_Ordner\1.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.SaveCopyAs Filename:=ActiveWorkbook.Path & "\1.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'Direkt im Anschluss: Öffnen der zu importierenden .csv-Datei mit Parametern (aufgezeichnet mit dem Makro-Rekorder)
Dim str$
str = str & "{{""Spal" & "te_1"", type text}, {""Spalte_2"", type text}, {""Spalte_3"", type text}, {""Spalte_4"", Int64.Type}, "
str = str & "{""Spalte_5"", type text}, {""Spalte_6"", type text}, {""Spalte_7"", type text}, {""Spalte_8"", type text}, "
str = str & "{""Spalte_9"", type text}, {""Spalte_10"", Int64.Type}, {""Spalte_11"", type text}, {""Spalte_12"", type text}, "
str = str & "{""SPalte_13"", type text}, {""Spalte_14"", type text}, {""Spalte_15"", type text}}) "
Dim sfilename$
sfilename = CsvFilePath
If sfilename = "" Then MsgBox "fehler ": Exit Sub
ActiveWorkbook.Queries.Add Name:="2", _
Formula:="let" & vbCrLf & " Quelle = Csv.Document(File.Contents(""" & sfilename & """), " & _
"[Delimiter="","", Columns=15, Encoding=65001, QuoteStyle=QuoteStyle.Csv])," & vbLf & _
"#""Höher gestufte Header"" = Table.PromoteHeaders(Quelle, [PromoteAllScalars=true])," & vbCrLf & _
"#""Geänderter Typ"" = Table.TransformColumnTypes(#""Höher gestufte Header"", " & str & _
vbCrLf & "in" & vbCrLf & "#""Geänderter Typ"""
'Hinzufügen eines Arbeitsblatte (aufgezeichnet mit dem Makro-Rekorder)
ActiveWorkbook.Worksheets.Add
'Parameter zum Einfügen (aufgezeichnet mit dem Makro-Rekorder)
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""2"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [2]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "_2"
.Refresh BackgroundQuery:=False
End With
'============================================
'... weiterer Code zur Weiterverarbeitung ...
'============================================
End Sub
'========================================================
' File Selection
'========================================================
Private Function CsvFilePath() As String
Dim FileDialog_ As FileDialog
Dim selection_ As Variant
Set FileDialog_ = Application.FileDialog(msoFileDialogFilePicker)
With FileDialog_
.Filters.Add "CSV", "*.csv", 1
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path
If .Show = -1 Then
CsvFilePath = .SelectedItems(1)
End If
End With
Set FileDialog_ = Nothing
End Function