Option Explicit
Public Sub Test()
On Error GoTo ErrHandler
Call ImportFromCSV( _
Filename:="R:\Präp-Listen Temp\NGS\Rohdaten\0123456789.summary.csv", _
Target:=Worksheets("Makro-Sheet").Range("C1"), _
Columns:=6)
Exit Sub
ErrHandler:
Call MsgBox(Err.Description, vbCritical, Err.Source & " - Fehler " & Err.Number)
End Sub
Private Sub ImportFromCSV(Filename As String, Target As Excel.Range, Optional Delimiter = ",", Optional Columns)
If Dir$(Filename) = "" Then
Call Err.Raise(53, Source:="ImportFromCSV()")
End If
If Target Is Nothing Then
GoTo ErrInvalidArg
End If
Dim objQueryTbl As Excel.QueryTable
Dim objQuery As Excel.WorkbookQuery
Dim strQuery As String
On Error GoTo ErrInvalidArg
strQuery = "let Source = Csv.Document(File.Contents(""" & Filename & """), " & _
"[Delimiter=""" & Delimiter & """" & IIf(IsMissing(Columns), "", ",Columns=" & Int(Columns)) & "]) in Source"
On Error GoTo 0
With Target.Worksheet.Parent.Queries
Set objQuery = .Add(Name:="__tempFileQuery", Formula:=strQuery)
End With
Dim strSource As String
strSource = "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & objQuery.Name & ";"
Set objQueryTbl = ActiveSheet.ListObjects.Add(SourceType:=0, Source:=strSource, Destination:=Target).QueryTable
With objQueryTbl
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [" & objQuery.Name & "]")
.RefreshStyle = xlInsertDeleteCells
.AdjustColumnWidth = True
.BackgroundQuery = False
End With
Call objQueryTbl.Refresh
Call objQueryTbl.ListObject.Unlist
Call objQuery.Delete
Exit Sub
ErrInvalidArg:
Call Err.Clear
Call Err.Raise(5, "ImportFromCSV()")
End Sub