Проблемы с макросом веб-запросов

Я написал макрос веб-запроса для импорта финансовых отчетов из Yahoo Finance на основе значения в ячейке A1. Он работал без проблем в течение последних нескольких недель, но внезапно он больше не возвращает никаких данных (но не вызывает ошибки). Если у кого-то есть какие-либо идеи, я был бы признателен за ваше руководство. Я разместил код ниже – спасибо!

Sub ThreeFinancialStatements() On Error GoTo Explanation Rows("2:1000").Select Selection.ClearContents Columns("B:AAT").Select Range(Selection, Selection.End(xlToRight)).Select Selection.ClearContents Dim inTicker As String inTicker = Range("A1") ActiveSheet.Name = UCase(inTicker) GetFinStats inTicker Exit Sub Explanation: MsgBox "Please make sure you type a valid stock ticker symbol into cell A1 and are not trying to create a duplicate sheet." & _ vbLf & " " & _ vbLf & "Also, for companies with different classes of shares (eg Berkshire Hathaway), use a hyphen to designate the ticker symbol instead of a period (eg BRK-A)." & _ vbLf & " " & _ vbLf & "Please also note that not every company has three years of financial statements, so data may appear incomplete or missing for some companies.", _ , "Error" Exit Sub End Sub Sub GetFinStats(inTicker As String) ' ' GetBalSheet Macro ' ' With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://finance.yahoo.com/q/bs?s=" & inTicker & "+Balance+Sheet&annual", Destination:= _ Range("$D$1")) .Name = "bs?s=PEP+Balance+Sheet&annual" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "9" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://finance.yahoo.com/q/is?s=" & inTicker & "+Income+Statement&annual", Destination _ :=Range("$J$1")) .Name = "is?s=PEP+Income+Statement&annual" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "9" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With With ActiveSheet.QueryTables.Add(Connection:= _ "URL;http://finance.yahoo.com/q/cf?s=" & inTicker & "+Cash+Flow&annual", Destination:= _ Range("$P$1")) .Name = "cf?s=PEP+Cash+Flow&annual" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "9" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With Range("A3").Select ActiveCell.FormulaR1C1 = "Current Ratio" Range("A4").Select ActiveCell.FormulaR1C1 = "Quick Ratio" Range("A5").Select ActiveCell.FormulaR1C1 = "Cash Ratio" Range("A6").Select Range("A7").Select ActiveCell.FormulaR1C1 = "Revenue Growth Rate" Range("A9").Select Columns("A:A").ColumnWidth = 21.86 ActiveCell.FormulaR1C1 = "ROA" Range("A10").Select ActiveCell.FormulaR1C1 = "ROE" Range("A11").Select ActiveCell.FormulaR1C1 = "ROIC" Range("B3").Select ActiveCell.Formula = "=F11/F28" Range("B4").Select ActiveCell.Formula = "=(F11-F8)/F28" Range("B5").Select ActiveCell.Formula = "=F5/F28" Range("B7").Select ActiveCell.Formula = "=(L2/N2)^(1/2)-1" Range("B9").Select ActiveCell.Formula = "=L35/SUM(F12:F18)" Range("B10").Select ActiveCell.Formula = "=L35/F47" Range("B11").Select ActiveCell.Formula = "=L35/(F47+SUM(F29:F33))" Range("B3").Select Selection.NumberFormat = "0.00" Range("B4").Select Selection.NumberFormat = "0.00" Range("B5").Select Selection.NumberFormat = "0.00" Range("B7").Select Selection.NumberFormat = "0.00%" Range("B9").Select Selection.NumberFormat = "0.00%" Range("B10").Select Selection.NumberFormat = "0.00%" Range("B11").Select Selection.NumberFormat = "0.00%" Range("A1").Select End Sub 

Очевидно, что ваш код работает против определенного листка:

 Rows("2:1000").Select 

Но что это за лист? Только вы можете это знать.

Как написано, это то, что является активным рабочим листом , независимо от того, насколько это важно.

Неквалифицированные, эти функции неявно ссылаются на ActiveSheet :

  • Range
  • Cells
  • Columns
  • Rows
  • Names

Поэтому вам нужно их квалифицировать . И вы это делаете, указав конкретный объект Worksheet они должны работать, – предположим, что это DataSheet (я не знаю):

 DataSheet.Rows("2:1000").Select 

Это будет. .Select строки на листе, на который указывает объект DataSheet .

Зачем вам это нужно. .Select ? Эта:

 Rows("2:1000").Select Selection.ClearContents 

Также может быть:

 DataSheet.Rows("2:1000").ClearContents 

Или лучше – если ваши данные отформатированы как таблица (кажется, это похоже на так или иначе – почему бы не использовать API ListObjects ?):

 DataSheet.ListObjects("DataTable").DataBodyRange.Delete 

Похоже, эта инструкция только что заменила все .ClearContents и .ClearContents . Обратите внимание, что. Выберите mimicks user action – пользователь, нажимая на ячейку (или что-то действительно) и выбрав ее . У вас есть программный доступ ко всей объектной модели – вам никогда не нужно. .Select что угодно!

 Dim inTicker As String inTicker = Range("A1") 

Здесь вы неявно читаете активный лист, но вы также неявно конвертируете Variant (значение ячейки) в String , что может или не может быть успешным. Если A1 содержит значение ошибки (например, #REF! ), #REF! терпит неудачу.

 With DataSheet.Range("A1") If Not IsError(.Value) Then inTicker = CStr(.Value) Else 'decide what to do then End If End With 

Ваша подпрограмма обработки ошибок должна, по крайней мере, Debug.Print Err.Number, Err.Description чтобы у вас было немного информации о том, почему все взорвалось. Сейчас он предполагает причину неудачи, и, как вы видели, Excel полон ловушек.

Также вы используете vbLf , но это только половина правильного символа новой строки Windows. Используйте vbNewLine если вы не знаете, что это такое.

Exit Sub инструкции непосредственно перед маркером End Sub полностью бесполезен.


 Sub GetFinStats(inTicker As String) 

Процедура неявно Public , а inTicker неявно передается ByRef . Престижность для того, чтобы дать ему явный тип!

Это было бы лучше:

 Private Sub GetFinStats(ByVal inTicker As String) 

 With ActiveSheet.QueryTables 

По крайней мере, это касается использования активного листа. Но следует ли использовать активный лист или конкретный лист? И что происходит с таблицами запросов, которые уже были там?

Я настоятельно рекомендую вам ввести его в ближайшее окно :

 ?ThisWorkbook.Connections.Count 

Если число больше, чем количество .QueryTables.Add которые у вас есть в вашей процедуре (вероятно), у вас есть проблема: я подозреваю, что у вас более ста .QueryTables.Add в .QueryTables.Add и нажмите кнопку «Обновить все» берет навсегда закончить, и вполне возможно, что finance.yahoo.com получает десятки запросов от одного IP-адреса в очень ограниченное время и отказывается обслуживать их.

Удалите все неиспользуемые подключения к книге. А затем исправьте неявные ссылки ActiveSheet там и избавьтесь от всех этих бесполезных вызовов. .Select :

 With TheSpecificSheet With .QueryTables.Add( ... ) End With With .QueryTables.Add( ... ) End With With .QueryTables.Add( ... ) End With 'assgin .Value, not .FormulaR1C1; you're not entering a R1C1 formula anyway .Range("A3").Value = "Current Ratio" .Range("A4").Value = "Quick Ratio" .Range("A5").Value = "Cash Ratio" End With 

Последовательные. .Select вызовы означает, что все, кроме последнего, служат цели, если таковые имеются:

 Range("A6").Select Range("A7").Select 

Опять же, не назначайте ActiveCell когда вы можете назначить .Range("A7").Value напрямую.

И вы можете установить числовые форматы для диапазона ячеек:

 .Range("B3:B11").NumberFormat = "0.00%" 

Оказывается, Yahoo закончила приложение, из которого веб-запрос извлек свои данные. Благодарим вас за все ваши советы.

Вы все равно можете получить необходимые данные, проанализировав ответ JSON либо из

https://finance.yahoo.com/quote/AAPL/financials
(извлечение данных из содержимого HTML, AAPL здесь только для примера)

или через API

https://query1.finance.yahoo.com/v10/finance/quoteSummary/AAPL?lang=en-US&region=US&modules=incomeStatementHistory%2CcashflowStatementHistory%2CbalanceSheetHistory%2CincomeStatementHistoryQuarterly%2CcashflowStatementHistoryQuarterly%2CbalanceSheetHistoryQuarterly%2Cearnings

Вы можете использовать приведенный ниже код VBA для анализа ответа и результата вывода. Импортируйте модуль JSON.bas в проект VBA для обработки JSON. Вот Sub Test_query1_finance_yahoo_com() для получения данных через API и Test_finance_yahoo_com_quote для извлечения данных из содержимого HTML:

 Option Explicit Sub Test_query1_finance_yahoo_com() Dim sSymbol As String Dim sJSONString As String Dim vJSON As Variant Dim sState As String sSymbol = "AAPL" ' Get JSON via API With CreateObject("MSXML2.XMLHTTP") .Open "GET", "https://query1.finance.yahoo.com/v10/finance/quoteSummary/" & sSymbol & "?lang=en-US&region=US&modules=incomeStatementHistory%2CcashflowStatementHistory%2CbalanceSheetHistory%2CincomeStatementHistoryQuarterly%2CcashflowStatementHistoryQuarterly%2CbalanceSheetHistoryQuarterly%2Cearnings", False .Send sJSONString = .ResponseText End With ' Parse JSON response JSON.Parse sJSONString, vJSON, sState If sState = "Error" Then MsgBox "Invalid JSON" Exit Sub End If ' Pick core data Set vJSON = vJSON("quoteSummary")("result")(0) ' Output QuoteDataOutput vJSON MsgBox "Completed" End Sub Sub Test_finance_yahoo_com_quote() Dim sSymbol As String Dim sJSONString As String Dim vJSON As Variant Dim sState As String sSymbol = "AAPL" ' Get webpage HTML response With CreateObject("Msxml2.XMLHTTP") .Open "GET", "https://finance.yahoo.com/quote/" & sSymbol & "/financials", False .Send sJSONString = .ResponseText End With ' Extract JSON from HTML content sJSONString = "{" & Split(sJSONString, "root.App.main = {")(1) sJSONString = Split(sJSONString, "}(this));")(0) sJSONString = Left(sJSONString, InStrRev(sJSONString, "}")) ' Parse JSON response JSON.Parse sJSONString, vJSON, sState If sState = "Error" Then MsgBox "Invalid JSON" Exit Sub End If ' Pick core data Set vJSON = vJSON("context")("dispatcher")("stores")("QuoteSummaryStore") ' Output QuoteDataOutput vJSON MsgBox "Completed" End Sub Sub QuoteDataOutput(vJSON) Const Transposed = True ' Output option Dim oItems As Object Dim vItem Dim aRows() Dim aHeader() ' Fetch main structures available from JSON object to dictionary Set oItems = CreateObject("Scripting.Dictionary") With oItems .Add "IncomeStatementY", vJSON("incomeStatementHistory")("incomeStatementHistory") .Add "IncomeStatementQ", vJSON("incomeStatementHistoryQuarterly")("incomeStatementHistory") .Add "CashflowY", vJSON("cashflowStatementHistory")("cashflowStatements") .Add "CashflowQ", vJSON("cashflowStatementHistoryQuarterly")("cashflowStatements") .Add "BalanceSheetY", vJSON("balanceSheetHistory")("balanceSheetStatements") .Add "BalanceSheetQ", vJSON("balanceSheetHistoryQuarterly")("balanceSheetStatements") .Add "EarningsChartQ", vJSON("earnings")("earningsChart")("quarterly") .Add "FinancialsChartY", vJSON("earnings")("financialsChart")("yearly") .Add "FinancialsChartQ", vJSON("earnings")("financialsChart")("quarterly") End With ' Output each data set to separate worksheet For Each vItem In oItems ' Convert each data set to array JSON.ToArray oItems(vItem), aRows, aHeader ' Output array to worksheet With GetSheet((vItem)) .Cells.Delete If Transposed Then Output2DArray .Cells(1, 1), WorksheetFunction.Transpose(aHeader) Output2DArray .Cells(1, 2), WorksheetFunction.Transpose(aRows) Else OutputArray .Cells(1, 1), aHeader Output2DArray .Cells(2, 1), aRows End If .Columns.AutoFit End With Next End Sub Function GetSheet(sName As String, Optional bCreate = True) As Worksheet On Error Resume Next Set GetSheet = ThisWorkbook.Sheets(sName) If Err Then If bCreate Then Set GetSheet = ThisWorkbook.Sheets.Add(, ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) GetSheet.Name = sName End If Err.Clear End If End Function Sub OutputArray(oDstRng As Range, aCells As Variant) With oDstRng .Parent.Select With .Resize(1, UBound(aCells) - LBound(aCells) + 1) .NumberFormat = "@" .Value = aCells End With End With End Sub Sub Output2DArray(oDstRng As Range, aCells As Variant) With oDstRng .Parent.Select With .Resize( _ UBound(aCells, 1) - LBound(aCells, 1) + 1, _ UBound(aCells, 2) - LBound(aCells, 2) + 1) .NumberFormat = "@" .Value = aCells End With End With End Sub 

Наконец, Sub QuoteDataOutput(vJSON) является объектом JSON, чтобы понять, как извлекаются необходимые данные из него, вы можете сохранить строку JSON в файл, скопировать содержимое и вставить его в любой просмотрщик JSON для дальнейшего изучения. Я использую онлайн-инструмент http://jsonviewer.stack.hu , структура целевого элемента показана ниже:

Структура JSON

Выход для меня следующий (первый рабочий лист показан):

Вывод

Существует 9 основных разделов, соответствующая часть данных извлекается и выводится на 9 рабочих листов:

 IncomeStatementY IncomeStatementQ CashflowY CashflowQ BalanceSheetY BalanceSheetQ EarningsChartQ FinancialsChartY FinancialsChartQ 

Имея этот пример, вы можете извлечь данные из этого ответа JSON.

  • VBA - ошибка времени выполнения 1004 «Определенная заявка или ошибка с определением объекта»
  • Как искать строку в массиве
  • Где находится VBA Debug.Print?
  • Как выделить ячейку с использованием значения цвета гексагональной ячейки?
  • Что делает ReDim Preserve?
  • Как вы запускаете .exe с параметрами с помощью оболочки vba ()?
  • Разбор даты и времени ISO8601 (включая TimeZone) в Excel
  • Какова функция FormulaR1C1?
  • Цикл через таблицы Excel
  • VBA для вставки встроенного изображения excel
  • При вводе формулы из VBA возникают разные языки
  • Interesting Posts

    Функции против методов в Scala

    Binding ElementName. Использует ли это Визуальное дерево или Логическое дерево

    startActivity () из BroadcastReceiver

    Как я могу использовать Takeown, чтобы взять на себя все папки на одном диске?

    VirtualBox Ubuntu VM не выполняет автоматическую синхронизацию времени с хостом даже с установленными гостевыми дополнениями

    Как уведомить о намерениях уведомления, а не делать новые намерения?

    Примеры делегатов в Swift

    Хэш-таблица / ассоциативный массив в VBA

    Не удалось найти допустимый путь сертификации для запрошенной целевой ошибки даже после импорта сертификата

    Использование двухэлементных разъемов (один для LAN, один для WAN)

    Удалить категорию и базу тегов из URL-адреса WordPress – без плагина

    перегрузка оператора друга << для шаблона classа

    Почему InputStream # read () возвращает int, а не байт?

    Плагин jquery.validate – как обрезать значения перед проверкой формы

    Реализация шаблона пула объектов C #

    Давайте будем гением компьютера.