AW: VBA Abfrage aus Datei - aus CSV
26.09.2017 13:33:23
Matthias
Moin!
Habe mal deinen Code zusammengefasst und ein SChleife durch alle Kürzel in Spalte B angelegt. Konnte es aber nicht testen, da mein altes System kein PowerQery kennt. Habe deshalb mal versucht den Code in der Abfrage dazu anzupassen (Kürzel der Seite, Wert aus Spalte G usw.). Bei der Abfrage müsste du ggf. noch die Strings anpassen, weiß nicht ob die Fehlerfrei für jeden Durchlauf hinhauen. HIer dier Code.
VG
Sub HistorischeKurseOnvista()
Dim blattname As String
Dim zeile As Long
Dim ende As Long
Dim kürzel As String
Call AbfragenLoeschen
Call Verbindungen_Loeschen
Call DeleteWorkSheets
Application.ScreenUpdating = False
ende = Sheets("Kürzel").Cells(Sheets("Kürzel").Rows.Count, 2).End(xlUp).Row
For zeile = 2 To ende
blattname = Sheets("Kürzel").Cells(zeile, 2)
kürzel = Left(blattname, Len(blattname) - 3)
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = blattname
ActiveWorkbook.Queries.Add Name:= _
"export csv?notationId=39517324&dateStart=22 09 2012&interval=Y5&assetName=" & kürzel & _
"" _
, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Quelle = Csv.Document(Web.Contents(" & Sheets("Kü _
rzel").Cells(zeile, 7) & "),[Delimiter="";"", Columns=6, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & " #""Höher gestufte Header"" = Table.PromoteHeaders(Quelle, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #" & _
"""Geänderter Typ"" = Table.TransformColumnTypes(#""Höher gestufte Header"",{{""Datum"", _
type date}, {""Eroeffnung"", type number}, {""Hoch"", type number}, {""Tief"", type number}, {""Schluss"", type number}, {""Volumen"", type number}})," & Chr(13) & "" & Chr(10) & " #""Sortierte Zeilen"" = Table.Sort(#""Geänderter Typ"",{{""Datum"", Order.Descending}})," & Chr(13) & "" & Chr(10) & " #""Entfernte Spalten"" = Table" & _
".oveColumns(#""Sortierte Zeilen"",{""Eroeffnung"", ""Hoch"", ""Tief"", ""Volumen""})" & _
Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Entfernte Spalten"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""export csv? _
notationId=39517324&dateStart=22 09 2012&interval=" _
, "Y5&assetName=" & kürzel & """"), Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array( _
"SELECT * FROM [export csv?notationId=39517324&dateStart=22 09 2012&interval=Y5& _
assetName=" & kürzel & "]" _
)
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = _
"export_csv_notationId_39517324_dateStart_22_09_2012_interval_Y5_assetName_" & kürzel
.Refresh BackgroundQuery:=False
End With
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Columns("B:B").NumberFormat = "#,##0.000"
Next zeile
Application.ScreenUpdating = True
End Sub
Sub Verbindungen_Loeschen()
Dim wb As Workbook, objConnection As Variant, varAuswahl As Long
Set wb = ActiveWorkbook
For Each objConnection In wb.Connections
Application.DisplayAlerts = False
objConnection.Delete
Application.DisplayAlerts = True
Next
End Sub
Sub AbfragenLoeschen()
Dim objQr
For Each objQr In ThisWorkbook.Queries
objQr.Delete
Next
End Sub
Sub DeleteWorkSheets()
Dim wks As Worksheet
Application.DisplayAlerts = False
For Each wks In ThisWorkbook.Worksheets
If wks.Name "Depot" And wks.Name "Kürzel" And wks.Name "Chart-Vorschau" And wks. _
Name "Yahoo API Tags" And wks.Name "Hilfe" Then
wks.Delete
End If
Next
Application.DisplayAlerts = True
End Sub