Option Explicit
Public Sub ImportCSV_Special(ByVal FilePath As String, ByVal Destination As Object)
Const C_VALUE_FORMAT As String = "0.00"
Const C_DATE_FORMAT As String = "m/d/yyyy"
Const C_TIME_FORMAT As String = "[$-F400]h:mm:ss AM/PM"
FilePath = Trim$(FilePath)
If Dir$(FilePath) = "" Then
Call MsgBox("CSV-Datei '" & FilePath & "' konnte nicht gefunden werden.", vbExclamation)
Exit Sub
End If
Dim rngDest As Excel.Range
Dim objQuery As WorkbookQuery
If Destination Is Nothing Then
Call MsgBox("Kein Zielort für Import der CSV-Datei '" & FilePath & "' vorhanden.", vbExclamation)
Exit Sub
ElseIf TypeOf Destination Is Excel.Worksheet Then
Set rngDest = Destination.Range("A1")
ElseIf TypeOf Destination Is Excel.Range Then
Set rngDest = Destination.Cells(1, 1)
Else
Call MsgBox("Der Zielort für Import der CSV-Datei '" & FilePath & "' ist ungültig.", vbExclamation)
Exit Sub
End If
Set objQuery = ThisWorkbook.Queries.Add("CSV-Request-" & Format$(Now, "yyyymmddhhnnss"), _
"let" & vbNewLine & _
"#""CSV-Src"" = Csv.Document(File.Contents(""" & FilePath & """),[Delimiter="";"", Columns=3, Encoding=1252, QuoteStyle=QuoteStyle.None])," & vbNewLine & _
"#""CSV-Src-T"" = Table.TransformColumnTypes(#""CSV-Src"",{{""Column1"", type text}, {""Column2"", type number}, {""Column3"", type datetime}})," & vbNewLine & _
"#""CSV-Source"" = Table.RenameColumns(#""CSV-Src-T"",{{""Column1"", ""Name""}, {""Column2"", ""Wert""}, {""Column3"", ""Datum""}})" & vbNewLine & _
"in" & vbNewLine & _
"#""CSV-Source""")
Dim objCon As WorkbookConnection
Dim pvt As Excel.PivotTable
Set objCon = ThisWorkbook.Connections.Add2(objQuery.Name & " - Connection", "", _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & objQuery.Name & ";Extended Properties=""""", _
"SELECT Name, (Wert / 1000000) As Wert, Datum FROM [" & objQuery.Name & "]", XlCmdType.xlCmdSql)
With ThisWorkbook.Worksheets.Add
Set pvt = ThisWorkbook.PivotCaches.Create(xlExternal, objCon).CreatePivotTable(.Range("A1"), "CSV-Pivot")
pvt.ColumnGrand = False
pvt.RowGrand = False
pvt.DisplayFieldCaptions = False
pvt.PivotFields("Name").Orientation = XlPivotFieldOrientation.xlColumnField
pvt.PivotFields("Wert").Orientation = XlPivotFieldOrientation.xlDataField
pvt.PivotFields("Datum").Orientation = XlPivotFieldOrientation.xlRowField
pvt.DataFields(1).NumberFormat = C_VALUE_FORMAT
Dim rngData As Excel.Range
Set rngData = pvt.RowRange.Resize(ColumnSize:=pvt.RowRange.Columns.Count + pvt.ColumnRange.Columns.Count)
rngDest.CurrentRegion.Clear
rngData.Copy rngDest
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
If Not objCon Is Nothing Then objCon.Delete
If Not objQuery Is Nothing Then objQuery.Delete
rngDest.Parent.Activate
Set rngDest = rngDest.CurrentRegion
rngDest.Columns(2).Resize(, 2).Insert xlShiftToRight
rngDest.Rows(1).Resize(, 3).Value = Array("", "Datum", "Uhrzeit")
With rngDest.Rows.Offset(1).Resize(rngDest.CurrentRegion.Rows.Count - 1)
.Columns(2).NumberFormat = C_DATE_FORMAT
.Columns(2).Formula = "=DATE(YEAR(RC[-1]),MONTH(RC[-1]),DAY(RC[-1]))"
.Columns(2).Value = .Columns(2).Value
.Columns(3).NumberFormat = C_TIME_FORMAT
.Columns(3).Formula = "=TIME(HOUR(RC[-2]),MINUTE(RC[-2]),SECOND(RC[-2]))"
.Columns(3).Value = .Columns(3).Value
.Columns(1).EntireColumn.Delete
.EntireColumn.AutoFit
End With
Call MsgBox("Import von '" & FilePath & "' erfolgreich abgeschlossen.", vbInformation)
End Sub