Question

我最近编写了一个VBA模块，将d / l股票价格数据存储到Excel（2016桌面）程序中。它可以工作，但是在Excel程序的加载项启动时导致错误。它似乎正在尝试加载某些.Net工具（在此模块之前从未执行过），并且此时失败并显示错误消息-2147417848。单击“确定”后，代码将运行，但是每次关闭所有Excel实例时，再次打开Excel都会显示错误。

我使用Power Query和宏记录器捕获了以下代码。我很乐意从另一个使用CSV或JSON的有效实现的代码开始。

在此先感谢您提供的任何帮助或建议。

Sub avGetQuotes(symbol As String, history As Boolean)
'
' Fetch historical and current quotes from Alpha Vantage
'
Dim size As String
Dim qt As WorkbookQuery
Dim apiKeyNow As String

apiKeyNow = [MY API KEY]
If history Then
    size = "full" 'all data
Else
    size = "compact" '100 days
End If
'clear any previous query data
activeSheet.Range("A:G").EntireColumn.Clear
For Each qt In ActiveWorkbook.Queries
   qt.Delete
Next qt
ActiveWorkbook.Queries.Add Name:="query1", _
    Formula:="let" & Chr(13) & "" & Chr(10) & _
" Source = Json.Document(Web.Contents(""http://www.alphavantage.co/query?function=TIME_SERIES_DAILY_ADJUSTED" _
    & "&symbol=" & symbol & "&outputsize=" & size & "&apikey=" & apiKeyNow & """))," & Chr(13) & "" & Chr(10) _
    & " #""Time Series (Daily)"" = Source[#""Time Series (Daily)""]," & Chr(13) & "" & Chr(10) _
    & " #""Converted to Table"" = Record.ToTable(#""Time Series (Daily)"")," & Chr(13) & "" & Chr(10) _
    & " #""Expanded Value"" = Table.ExpandRecordColumn(#" & """Converted to Table"", ""Value"", " _
    & "{""1. open"", ""2. high"", ""3. low"", ""4. close"", ""5. adjusted close""}," _
    & "{""Open"", ""High"", ""Low"", ""Close"", ""Adjusted close""})" _
    & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Expanded Value"""
''Uncomment to run query on new sheet
'Sheets.Add After:=activeSheet
With activeSheet.ListObjects.Add(SourceType:=0, Source:=Array( _
    "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""query1"";Extended Properties="""""), Destination:=Range("$A$1")).QueryTable
    .CommandType = xlCmdSql
    .CommandText = Array("SELECT * FROM [query1]")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = False
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .ListObject.DisplayName = "query1"
    .Refresh BackgroundQuery:=False
End With
'Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
With activeSheet
    .Range("A1:F1").AutoFilter
    .Range("A1") = "Date" 'change from "Name"
    .Range("F1:F501") = .Range("F1:F501").value 'Force first 500 adjusted prices from text to values
    With .UsedRange.columns("A").Cells
        .TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, FieldInfo:=Array(0, xlYMDFormat)
        .NumberFormat = "mm/dd/yy"   'change to any date-based number format you prefer the cells to display
    End With
End With
'clean up Power Query
ActiveWorkbook.Queries("query1").Delete
Do While ActiveWorkbook.Connections.count > 0
   ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.count).Delete
Loop
End Sub

Excel .xlam加载项在启动时导致错误[错误-2147417848]

0 个答案: