Query muy lento en consulta web

[afigueroaf]

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

[Abraham Valencia]

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).

[afigueroaf]

Hola Abraham,

Muchas gracias por tu respuesta, la variable Hostname es de este tipo: http://e14spence.enlazza.net:6209/login.asp

Como puedes ver es tan sólo una dirección web, no tiene parámetros

Lamentablemente ya está todo el desarrollo hecho en excel

[Abraham Valencia]

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.

[afigueroaf]

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,

 

[Abraham Valencia]

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?

[afigueroaf]

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

[Abraham Valencia]

¿Cuál es tu versión de Office?

[afigueroaf]

Microsoft Excel 2013 (15.0.4420.1017) MSO (15.0.4420.1017) 32 bits

[Abraham Valencia]

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":

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":

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

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

 

[afigueroaf]

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

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
 

[Abraham Valencia]

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.

[afigueroaf]

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

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, 

 

[Abraham Valencia]

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.

[afigueroaf]

MARAVILLOSO!!!

De 40 min aproximadamente, ahora se demora 4min 

Muchas gracias Abraham

[Abraham Valencia]

Jejeje, de nada estimado. Saludos

[afigueroaf]

Sólo una consultilla más,

Para sitios con HTTPS, debería haber alguna consideración respecto del código VBA?

Ejemplo: 

https://mpe.enlazza.net:5906/login.asp   Grax

[Abraham Valencia]

Hola. Pues no debería haber dilema, pero el dilema es ese enlace es que al menos en Chrome no carga y Edge lo coloca como "sitio no seguro".

[afigueroaf]

En 13/10/2019 at 23:12 , avalencia dijo:

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.

Estimado Abraham, gracias por la solución, funciona a la perfección, pero como le puedo agregar un poquito de delay para que espere la respuesta de aquellos sitios que demoran un poco más en cargar, antes de que lo tome como "Titulo = """?