Jump to content
afigueroaf

Query muy lento en consulta web

Recommended Posts

Estimados gusto en saludarlos,

Estaba fuera de las pistas, pero he vuelto, y quería ver la posibilidad que me puedan dar una mano con lo siguiente:

Tengo una Macro que actualiza información proveniente de distintos sitios web, el problema es que muchas veces algunos sitios se encuentran muy lentos, o simplemente no disponibles, entonces la Macro queda eternamente esperando respuesta. Es posible indicarle al Query, que continúe con el siguiente sitio después de un tiempo determinado, para evitar que la Macro se demore demasiado? 

Gracias,

Adjunto código:

Sub WebDataImport()
On Error GoTo ControlErr
 
Dim strURL As String
Dim strDestino As String, strReportName As String
Dim numConnections As Integer, i As Integer
 
Application.DisplayAlerts = False               'omitimos los mensajes de aviso
'vars
numConnections = ThisWorkbook.Connections.Count
strDestino = "A1"
strReportName = "Número de serie"
strURL = Hostname

'check url data
If strURL <> Empty Then
    'custom url address
    'strURL = "URL;" & strURL
 
    'clean previous connections
    If numConnections > 0 Then
        For i = 1 To numConnections
            ThisWorkbook.Connections(i).Delete
        Next i
    End If

 
'clean datasheet
'Sheets("Match").Select
'Range("A1").Select
'    Selection.QueryTable.Delete
'    Selection.QueryTable.Delete
'    Selection.QueryTable.Delete
'    Selection.ClearContents

Sheets("Match").Cells.Clear
 
'control excel app
Application.ScreenUpdating = False
 
  'Dim t As Single 'Inicia el cronómetro
  't = Timer
  'get web query
With Sheets("Match").QueryTables.Add(Connection:=strURL _
    , Destination:=Range(strDestino))
    .Name = strReportName
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 2
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
    'If Timer - t > 10 Then
    '    Resume Next
    'End If
    'Application.Wait (Now + TimeValue("0:00:10"))
    'Selection.QueryTable.Refresh BackgroundQuery:=False
End With
'MsgBox Timer - t, vbInformation, "Segundos" ' Muestra el tiempo transcurrido

'If Range(strDestino) = Empty Then
Application.Wait (Now + TimeValue("0:00:5"))
BackgroundQuery = False

'End If
'control excel app
Application.ScreenUpdating = True

Application.DisplayAlerts = True
Caunt2 = Caunt2 + 1 - 2
MyTitle = "Hostname " & Caunt2 & " de " & Caunt1
'final message
'Answer = MsgBox("Do you want to continue ?", vbYesNo + vbQuestion, MyTitle)
'If Answer = 6 Then
'    Else
'    End
'    Exit Sub
'End If


End If

Exit Sub
 
ControlErr:
Range(Cells(1, 1), Cells(1, 1)) = ""
'MsgBox "Error: " & Err.Description, vbCritical, "Mensaje"
  
End Sub

Fichero.txt

Edited by afigueroaf
Ortografía + código VBA

Share this post


Link to post
Share on other sites

Hola

Ufff, hace años que no veía a alguien usando Microsoft Query, ya sea como herramienta "normal" o a través de VBA ¿Por qué no usas Power Query o un objeto Internet Explorer? En el primer caso tiene una propiedad de tiempo de espera y una llamada TimeOut para VBA  y en el segundo caso se usa las propiedades del mismo navegador mencionado. Ah, una alternativa más rápida que IE es usar MSXML2 pero, desde mi punto de vista, es un poco más difícil de programar.

Si insistes con lo que ya tienes, pues, creo recordar que las cadenas de conexión como la que necesitas, tenían un parámetro "pagetimeout", pero no muestras tu cadena (tu variable Hostname) como para indicarte en dónde se usa, claro, si es que realmente era así (muchos años sin usar).

Share this post


Link to post
Share on other sites

Hola nuevamente

Las alternativas que te he dado son de Excel, no entiendo por qué mencionas eso de  ya está todo el desarrollo hecho en excel, pero ante la duda, mejor aclaro varios puntos:

- Lo que tu usas ahí es VBA en Excel, en específico Excel Web Query  de Microsoft Query, pero, repito, desde VBA. Ojo conque  ya es una    herramienta desfasada y que no se usa sobre todo porque ha sido superada por otras ya mencionadas. Por cierto, después de repasar material antiguo, pues no, al parecer (casi 100% seguro) Excel Web Query no tiene alguna propiedad o parámetro relacionado con el tiempo de espera para que carguen los datos de una web por lo que no hay forma de lograr lo que solicitas si quieres mantener ese mismo código.

- A diferencia de Microsoft Query, Power Query (integrado a Excel en las últimas versiones o en complementos en anteriores) sí tiene una propiedad como la que necesitas y también es posible que se use con VBA. Incluso podrías iniciar con la grabadora de macros.

- Usa el objeto Internet Explorer y/o MSXML2, también es VBA por si acaso.

Resumen, si deseas lograr lo del tiempo tienes que usar alguna de las alternativas planteadas.

Share this post


Link to post
Share on other sites

Ahh, gracias por la aclaración, ahora entiendo, entonces tienes algún ejemplo de código para utilizar las recomendaciones que mencionas en lugar de continuar con el query obsoleto?

 

Saludos,

 

Share this post


Link to post
Share on other sites

Asumiendo que tienes una versión reciente de Excel o el complemento Power Query activado, aquí algo obtenido con la grabadora de macros (tal cual, sin depurar por si acaso):

Sub Macro2()
'
' Macro2 Macro
'

'
    ActiveWorkbook.Queries.Add Name:="Table 15", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Origen = Web.Page(Web.Contents(""https://www.uv.es/jac/guia/tablaeje.htm"", [Timeout=#duration(0, 0, 6, 0)]))," & Chr(13) & "" & Chr(10) & "    Data15 = Origen{15}[Data]," & Chr(13) & "" & Chr(10) & "    #""Tipo cambiado"" = Table.TransformColumnTypes(Data15,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Tipo cambiado"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 15"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table 15]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table_15"
        .Refresh BackgroundQuery:=False
    End With
End Sub

¿ Ves ahí el Timeout?

Share this post


Link to post
Share on other sites

Hola Abraham,

Gracias por la ayuda, pero me da "Error 438 en tiempo de ejecución El objeto no admite esta propiedad o método"

No sé si habré reemplazado mal la variable "Hostname" en el código, o simplemente mi Excel no es compatible?


ActiveWorkbook.Queries.Add Name:="Table 15", Formula:="let" & Chr(13) & "" & Chr(10) & "Origen = Web.Page(Web.Contents(Hostname, [Timeout=#duration(0, 0, 6, 0)]))," & Chr(13) & "" & Chr(10) & "    Data15 = Origen{15}[Data]," & Chr(13) & "" & Chr(10) & "    #""Tipo cambiado"" = Table.TransformColumnTypes(Data15,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Tipo cambiado"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 15"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table 15]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table_15"
        .Refresh BackgroundQuery:=False
    End With

Share this post


Link to post
Share on other sites

Primero que nada, descarga Power Query para Excel 2013:

Enlace

Una vez instalado, solo por si acaso, verifica que en Archivo - Opciones - Complementos, en "Administrar" elegir "Complementos com", dale clic al botón "Ir..." y que esté activado "Microsoft PowerQuery for Excel", de no estarlo, actívalo y listo.

Ahora, no olvides que lo que yo he enviado es un ejemplo basado en una web y una tabla de dicha web con ciertas características que no necesariamente se repiten y/o tienen otras webs u otras tablas, entonces lo que tú debes hacer es activar tu grabadora de macros, en la pestaña "Power Query" en el grupo "Obtener datos externos" busca el botón "Desde la web":

PQ1.thumb.JPG.62e7259f55a2388505baaebc6eec264e.JPG

En el diálogo que sale activa "Avanzado" y llena la opción, ademas de la web, de "Tiempo de espera..." y dale clic a "Aceptar":

PQ2.thumb.JPG.cc394ee97e4bd07797d87a46cb0b7bba.JPG

En la estructura de la web elige la que necesites y dale clic al botón "Cargar":

PQ3.thumb.JPG.e5bbc9fe16a2b7a1be6a0e2a563372b9.JPG

Listo, desactiva la grabadora de macros y analiza el código obtenido. Comentas.

 

Share this post


Link to post
Share on other sites

Hola Abraham,

Gracias por toda la ayuda, pero no me resultó, al intentar acceder al hostname mediante powerquery no me deja y despliega un error

image.png.a691d8b0fb8ef9f277269747496585c1.png

Luego intenté con otro sitio web, pero al visualizar el código obtenido sólo muestra 3 líneas de código

Sub Macro2()
'
' Macro2 Macro
'

'
    Selection.AutoFilter
    ActiveSheet.ListObjects("Document").Resize Range("$A$1:$D$2")
    Range("Document[[#Headers],[Document]]").Select
End Sub
 

Share this post


Link to post
Share on other sites

Estimado, sigues sin, en realidad, dar detalles de la web, sigues solo escribiendo/diciendo "Hostname", lo que no es suficiente para probar nosotros y saber en dónde y/o cuál puede ser el dilema ¿será que es una web de intranet y no lo mencionaste? ¿será que es una web con usuario y clave y tampoco lo mencionaste?  Y en esa web que dices solo te extrajo tres líneas ¿no será que en realidad no tiene más y/o que no elegiste la opción correcta de datos? ¿qué web es? ¿es de intranet? Etc.

Share this post


Link to post
Share on other sites

Hola Abraham, 

Pero si ya lo había mencionado anteriormente, Hostname es sólo la variable que contiene el sitio web, y un ejemplo de sitio web es: http://wr31solek.enlazza.net:6400/login.asp

image.thumb.png.9160d36d234d673dc94242d0660afba1.png

Sólo necesito capturar el SN: 825846

Actualmente la macro que tengo funciona a la perfección, sólo que se demora demasiado y por eso quisiera mejorar los tiempos

Saludos, 

 

Share this post


Link to post
Share on other sites

Tienes razón, hubo un mensaje en que colocaste una web similar. Probando puedo ver el error que mencionas y al parecer está relacionado a las cookies y/o la seguridad de la web y/o el usar http en lugar de htpps y/o la API de la web (o simialres) y/o la estructura dada por Net a dichas web ¿soluciones? Limpiar cookies o usar https en lugar de http, si no resultan, Power Query no tiene otra forma directa de extraer los datos, con lo que estaría descartada esta herramienta para casos como el tuyo.

Una alternativa si  en todos lo casos esa frase corresponde con el título de las páginas, pues sería usar algo así:

Dim Titulo$
Dim objHttp As Object

Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
objHttp.Open "GET", "http://wr31solek.enlazza.net:6400/login.asp", False
objHttp.Send ""

Titulo = objHttp.ResponseText

If InStr(1, UCase(Titulo), "<TITLE>") Then
    Titulo = Mid(Titulo, InStr(1, UCase(Titulo), "<TITLE>") + Len("<TITLE>"))
    Titulo = Mid(Titulo, 1, InStr(1, UCase(Titulo), "</TITLE>") - 1)
Else
    Titulo = ""
End If

MsgBox Titulo

El enlace puede ser reemplazado por una variable que use todas tu web, y del resultado de la variable "Titulo" pues no debería serte difícil extraer lo necesario, incluso solo usando fórmulas de Excel (después de colocar en celda/s dicha variable) si es que se te complica con VBA.

Comentas.

Share this post


Link to post
Share on other sites



×
×
  • Create New...

Important Information

Privacy Policy