Ошибка 80010108 при удалении веб-соединения после веб-очистки с помощью VBA - PullRequest
0 голосов
/ 06 января 2019

У меня есть следующий код для получения некоторых данных из веб-таблицы.

Sub Retrieve_ticker_list()

    Dim Stockticker As Long                      'loopvalue (URL link) you want to use

    Dim DownloadInfoSheet As Worksheet
    Set DownloadInfoSheet = ActiveWorkbook.Worksheets("DownloadInfo")

    Dim DataSheet As Worksheet
    Set DataSheet = ActiveWorkbook.Worksheets("Data")

    Dim lastrowStock As Long
    Dim lastrowG As Long

    Dim baseURL As String
    Dim searchResultsURL As String

    lastrowStock = DownloadInfoSheet.Cells(Rows.Count, "C").End(xlUp).Row 'Find last row in Stockticker
    lastrowG = DataSheet.Cells(Rows.Count, "A").End(xlUp).Row + 10 'Find last row in range PART3


    For Stockticker = 2 To lastrowStock          'Loop from page 2 to lastrow

        baseURL = DownloadInfoSheet.Cells(2, "A") 'download from cell A2: 
        searchResultsURL = baseURL & DownloadInfoSheet.Cells(Stockticker, "C").Value 'Add the ticker symbol to the original URL link, example             
        With DataSheet _
             .QueryTables.Add(Connection:="URL;" & searchResultsURL, Destination:=DataSheet.Range(DataSheet.Cells(1, "A"), DataSheet.Cells(lastrowG, "A")))
            .Name = _
                  "Stock Data"
            .BackgroundQuery = True
            .RefreshStyle = xlOverwriteCells
            .TablesOnlyFromHTML = True
            .WebSelectionType = xlSpecifiedTables
            .WebTables = """Rf"""
            .PreserveFormatting = True
            .Refresh BackgroundQuery:=False
            Call Delete_Query_Content_Data 'See code below. I have tried to have this inside and outside the "with" loop
        End With

        Call RunProcess 'calculate adjusted key-ratios
    Next Stockticker

End Sub

У меня возникли проблемы при попытке удалить соединение. Если веб-таблица существует и вставлена ​​в книгу, я могу без проблем удалить соединение с помощью приведенного ниже кода.

Однако, если URL-адрес неправильный (недопустимое имя продавца), код работает (вставьте пустые данные), но я не могу удалить соединение. Я могу вручную перейти к «Данные» -> «Соединения» -> «Удалить», но это не работает с кодом. Либо соединение не удаляется (если lastrowG = 1), либо я получаю следующую ошибку (lastrowG = ... row + 10):

enter image description here

Код для удаления соединения запроса таблицы:

Sub Delete_Query_Content_Data()
' This code works when the URL code is valid, however if the code has an invalid stockticker (i.e. ADPA)
 'it doesn't remove the connection (if I set lastrowG = 1) otherwise it mostly gives the error message 80010108 
'Clear Web Query for "Stock data"
Sheets("Data").Activate
Range("A1").Select
Selection.QueryTable.Delete
Selection.ClearContents

End Sub

Я пытался заменить Delete_Query_Content_Data на предложения из stackoverflow (пример « Уничтожение соединения в EXCEL vba » и « Экспорт в Excel VBA в Excel - Удаление подключений »), но ни одного из них решает мою проблему, я все еще получаю сообщение об ошибке.

Ответы [ 2 ]

0 голосов
/ 07 января 2019

Я бы посмотрел на фактический запрос xmlhttp как на более быстрый метод поиска. Пока что, хотя и немного необычно, просмотрите структурную переписку вашего ответа с некоторыми примечаниями.

Примечание:

1) Перемещение объекта IE из цикла и создание видимого перед циклом. То же самое для некоторых других переменных, не затронутых циклом, например BaseUrl.

2) Сокращение выбора значений для максимума и минимума за последние 52 недели с использованием селекторов css для выбора соответствующих элементов

3) При необходимости используйте операторы With, например. для определения lastrowStockTickerPE

4) Убрать лишнее дополнительное ожидание

5) Удалить Set = Ничего, где не требуется, поскольку объекты будут разыменовываться, когда находятся вне области действия

Option Explicit  
Public Sub Retrieve_PE_Low_High()
    Dim DownloadInfoSheet As Worksheet, OutputSheet As Worksheet
    Dim Stockticker As Long, lastrowStockTickerPE As Long
    Dim baseURL As String, searchResultsURL As String
    Dim HTMLDoc As HTMLDocument, oIE As InternetExplorer

    Set DownloadInfoSheet = ActiveWorkbook.Worksheets("DownloadInfo") 'Sheet to retrieve stockticker from
    Set OutputSheet = ActiveWorkbook.Worksheets("Output") 'Where data will be assigned
    Set oIE = New InternetExplorer
    baseURL = DownloadInfoSheet.Cells(3, "A")

    With DownloadInfoSheet
        lastrowStockTickerPE = .Cells(.Rows.Count, "D").End(xlUp).Row
    End With

    With oIE
        .Visible = True

        For Stockticker = lastrowStockTickerPE To lastrowStockTickerPE '<==presumably your endpoint is not always the same as start

            searchResultsURL = baseURL & DownloadInfoSheet.Cells(Stockticker, "C").Value 'Add the ticker symbol to the original URL link, example "https://www.nasdaq.com/symbol" + "ADP" = "https://www.nasdaq.com/symbol/ADP"

            .Navigate2 searchResultsURL

            While .Busy Or .readyState < 4: DoEvents: Wend

            Set HTMLDoc = .document

            Dim high As Object, low As Object
            With HTMLDoc
                On Error Resume Next
                Set high = .querySelector(".infoTable.trading-activitiy tr + tr td:last-child")
                Set low = .querySelector(".infoTable.trading-activitiy tr + tr + tr td:last-child")
                Debug.Print high.innerText, low.innerText
                On Error GoTo 0
                If high Is Nothing Or low Is Nothing Then
                    'dummy
                Else
                    'other code to write to sheet
                End If
            End With
            Set high = Nothing: low = Nothing
        Next Stockticker
        .Quit
    End With
End Sub

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

Option Explicit   
Public Sub GetInfo()
    Dim sResponse As String, html As HTMLDocument, high As Object, low As Object
    Set html = New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.nasdaq.com/symbol/AAPL", False
        .send
        html.body.innerHTML = StrConv(.responseBody, vbUnicode)
    End With

    On Error Resume Next
    Set high = html.querySelector(".infoTable.trading-activitiy tr + tr td + td")
    Set low = html.querySelector(".infoTable.trading-activitiy tr + tr + tr td + td")
    Debug.Print high.innerText, low.innerText
    On Error GoTo 0
End Sub
0 голосов
/ 07 января 2019

Если бы что-то иное могло принести пользу, я бы настоятельно рекомендовал поискать этот пост: просмотр веб-страниц с использованием vba с использованием XMLHTTP

Это моя интерпретация кода, предоставленного Грэмом Андерсоном.

Я добавил:

  • Цикл расширения URL-адреса (т. Е. Nasdaq.com/symbol/ цикл этого тикера).
  • Добавлен простой обработчик ошибок (он больше пропускает ошибку, оставляет заметку и продолжается), чтобы избежать прерывания.
  • Направьте код, чтобы копировать только определенные элементы обратно на листы. (Экономит время вместо распечатки всей таблицы и последующего поиска, какое значение я хочу использовать)

Преимущество использования HTML / XMLHTTP по сравнению с превосходным веб-импортом (мой код в вопросе) состоит в том, что числовые значения напрямую распознаются . При использовании подхода QueryTables я потерял нули, поскольку числа были в формате США («.» в качестве разделителя, а я использую «,»). С помощью приведенного ниже кода цифры приходят с самого начала в порядке, это экономит много времени.

Sub Retrieve_PE_Low_High()
Dim Stockticker As Long 'loopvalue (URL extension to link) you want to use
Dim DownloadInfoSheet As Worksheet
Set DownloadInfoSheet = ActiveWorkbook.Worksheets("DownloadInfo") 'Sheet to retrieve stockticker from

Dim OutputSheet As Worksheet
Set OutputSheet = ActiveWorkbook.Worksheets("Output") 'Where data will be assigned
Dim lastrowB As Long

Dim lastrowStockTickerPE As Long
Dim lastrowStockPE As Long

Dim baseURL As String
Dim searchResultsURL As String

lastrowStockTickerPE = DownloadInfoSheet.Cells(Rows.Count, "D").End(xlUp).Row 'Find last row in Stockticker

For Stockticker = lastrowStockTickerPE To lastrowStockTickerPE 'Loop from page 2 to lastrow
    baseURL = DownloadInfoSheet.Cells(3, "A") 'download from cell A2: https://www.nasdaq.com/symbol
    searchResultsURL = baseURL & DownloadInfoSheet.Cells(Stockticker, "C").Value 'Add the ticker symbol to the original URL link, example "https://www.nasdaq.com/symbol" + "ADP" = "https://www.nasdaq.com/symbol/ADP"

    '#Microsoft HTML Object Library - Activate by Tools -> References
    '#Microsoft Internet Controls - Activate by Tools -> References
    Dim HTMLDoc As New HTMLDocument
    Dim AnchorLinks As Object
    Dim TDelements As Object
    Dim tdElement As Object
    Dim AnchorLink As Object
    Dim lRow As Long
    Dim lCol As Long
    Dim oElement As Object
    Dim i As Integer

    Dim oIE As InternetExplorer

    Set oIE = New InternetExplorer

    oIE.navigate searchResultsURL
    oIE.Visible = True

    'Wait for IE to load the web page
    Do Until (oIE.readyState = 4 And Not oIE.Busy)
        DoEvents
    Loop

    'Wait for Javascript to run
    Application.Wait (Now + TimeValue("0:00:15"))

    HTMLDoc.body.innerHTML = oIE.document.body.innerHTML


    With HTMLDoc.body
        Set AnchorLinks = HTMLDoc.getElementsByClassName("infoTable trading-activitiy") 'The "getElementsByClassName" is found by righ-click the element you want to retrieve data. This is the higher node (table)

        For Each AnchorLink In AnchorLinks
            'Debug.Print AnchorLink.innerText
            Set TDelements = AnchorLink.getElementsByTagName("td") 'The "getElementsByTagName" is found by righ-click the element you want to retrieve data. This is the lower node (single value)
        Next AnchorLink

        'lRow = 1
        'Print complete table of "infoTable trading-activitiy" to see what each element has for row.
        'If "High/Low 52 wk price" prints out at row 99, then the element index number is 98.
        'You could also search for items by: Debug.Print TDelements.Item(i).innerText, where i = a number
        'For Each tdElement In TDelements
        '    Debug.Print tdElement.innerText
        '    Cells(lRow, 1).Value = tdElement.innerText
        '    lRow = lRow + 1
        'Next tdElement

        If TDelements Is Nothing Then
            Call Dummy_PE                    'If object "TDelements is not populated/nothing (i.e. URL is not working or getElementsByClassName is not found) go to Dummy_PE
        Else
            lastrowStockPE = OutputSheet.Cells(Rows.Count, "G").End(xlUp).Row 'Find last row in Stockticker
            For i = 5 To 3 Step -1           'Loop through the TDelements items 5 to 3
                Select Case i
                Case 3, 5                    'For TDelements items 3 and 5, copy those to the sheet
                    'Debug.Print TDelements.Item(i).innerText
                    OutputSheet.Cells(lastrowStockPE - 1, 6).Value = TDelements.Item(i).innerText
                    OutputSheet.Cells(lastrowStockPE - 1, 6).NumberFormat = "General"
                    OutputSheet.Cells(lastrowStockPE - 1, 7).ClearContents
                    If OutputSheet.Cells(lastrowStockPE - 1, 6).Value = "" Then
                        OutputSheet.Cells(lastrowStockPE - 1, 2).Font.Color = vbRed
                    End If
                    lastrowStockPE = lastrowStockPE + 1
                End Select
            Next i

        End If

    End With

    oIE.Quit

    Set AnchorLinks = Nothing
    Set AnchorLink = Nothing
    Set TDelements = Nothing
    Set tdElement = Nothing
    Set HTMLDoc = Nothing
    Set olE = Nothing

Next Stockticker
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...