Macro para recorrer una consulta web: sigue bombardeando

He creado una macro destinada a recorrer los tickers de stock y en una columna y usar una consulta web para extraer datos sobre esos tickers de yahoo finance

Funciona bien para 10,15,20 consultas web, pero sin fallas las bombas sobresalen en algún momento en las primeras 20 o 30 consultas web

Seré el primero en decir que soy un aficionado extremo en el código VBA, pero he intentado algunas cosas para solucionar este problema (borrar el caché, usar pausas) y parece que no funcionan.

No falla siempre en el mismo elemento, pero siempre tiene el texto "conexión a la web" en la barra de estado, por lo que siento que tiene algo que ver con el tiempo de espera de la conexión, pero no estoy seguro de cómo atacarlo en este punto. Cualquier idea sería bienvenida, así como cualquier optimización de código que me pueda faltar ... ¡gracias!

Sub GetData()

    Application.Calculation = xlManual

     ' make the website a variable
    Dim sURL As String
    Dim Ticker As String
    Dim iRow As Integer
    Dim iCol As Integer
    Dim wqError As ErrObject

     ' create web query if it doesn't exist

    If Worksheets("query").QueryTables.Count = 0 Then
        With Worksheets("query").QueryTables.Add(Connection:="URL;", Destination:=Range("Query!A1"))
            .Name = "market_data.asp"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "4"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
        End With
    End If

    iRow = 2
    iCol = 2

     'Loop through Tickers

    Do While Worksheets("Data").Range("A" & iRow).Value <> ""

            Ticker = Worksheets("Data").Range("A" & iRow).Value
            sURL = "http://finance.yahoo.com/q?s=" & Ticker

            With Worksheets("query")
                .Cells.Clear
                .QueryTables(1).Connection = "URL;" & sURL
                On Error Resume Next
                .QueryTables(1).Refresh BackgroundQuery:=False
                Set wqError = Err
                On Error GoTo 0

                If wqError.Number = 0 Then 'No error

                    .Range("B1").Copy Worksheets("Data").Cells(iRow, iCol)
                    .Range("B5").Copy Worksheets("Data").Cells(iRow, iCol + 1)
                    .Range("B13:B14").Copy Worksheets("Data").Cells(iRow, iCol + 2)
                    .Range("B18").Copy Worksheets("Data").Cells(iRow, iCol + 4)
                    .Range("B15").Copy Worksheets("Data").Cells(iRow, iCol + 5)
                    .Range("B22").Copy Worksheets("Data").Cells(iRow, iCol + 6)
                    .Range("B16").Copy Worksheets("Data").Cells(iRow, iCol + 7)
                    .Range("B20").Copy Worksheets("Data").Cells(iRow, iCol + 8)
                    .Range("B19").Copy Worksheets("Data").Cells(iRow, iCol + 9)
                    .Range("B25").Copy Worksheets("Data").Cells(iRow, iCol + 10)
                    .Range("B24").Copy Worksheets("Data").Cells(iRow, iCol + 11)

                ElseIf wqError.Number <> 1004 Then

                     'Report error because it isn't the expected error 1004 Web query returned no data

                    MsgBox "Web query refresh for " & String(2, vbCrLf) & sURL & String(2, vbCrLf) & " returned error number " & wqError.Number & String(2, vbCrLf) & wqError.Description

                End If

            End With

        iRow = iRow + 1
        If iRow Mod 5 = 0 Then Delete_IE_Cache
        If iRow Mod 20 = 0 Then ActiveWorkbook.Save
        If iRow Mod 20 = 0 Then Application.Wait (Now + TimeValue("0:00:03"))

    Loop

     'Format results

    With Sheets("data")
    Range("A:M").HorizontalAlignment = xlCenter
    Range("A:A").NumberFormat = "Text"
    Range("D:D").NumberFormat = "Text"
    Range("I:I").NumberFormat = "Text"
    Range("B:C").NumberFormat = "0.00"
    Range("E:H").NumberFormat = "0.00"
    Range("K:M").NumberFormat = "0.00"
    End With

    Application.Calculation = xlCalculationAutomatic

End Sub

microsoft-excel vba macros jw90
fuente

"Bombas de Excel" significa "accidentes de Excel"? ¿"Excel se cierra"? Los tiempos de espera predeterminados pueden ser superiores a 90 segundos. has esperado?

Yorik

Sí, lo siento, no fue una redacción excelente. Quiero decir que veo que la macro pega los datos fila por fila, luego Excel entra en modo "no responde" y se congela.

jw90

He esperado un par de minutos antes para ver si reviviría, pero no lo ha hecho las pocas veces que lo intenté

jw90

Supongo que es la Waitllamada ("El método Wait suspende toda la actividad de Microsoft Excel y puede impedir que realice otras operaciones en su computadora mientras Wait está en vigor"). Una construcción alternativa podría ser una DoEventsllamada en un bucle que compara Ahora con el tiempo transcurrido deseado. (como aquí stackoverflow.com/questions/21385844 )

Yorik

Puede intentar recuperar los datos necesarios a través de XHR y analizarlos como en esta respuesta .

omegastripes

Macro para recorrer una consulta web: sigue bombardeando

Respuestas: