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
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 = """?

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

INFORMACIÓN BÁSICA SOBRE PROTECCIÓN DE DATOS

Responsable: Sergio Andrés Celemín

Finalidad: Moderar y responder comentarios de usuarios. Recuerda que la información que facilites es pública, y los datos que incluyas los leerá cualquier visitante de esta web, así como el avatar que poseas.

Legitimación: Consentimiento del interesado.

Destinatarios: Hetzner Online GmbH.

Derechos: Puedes ejercitar en cualquier momento tus derechos de acceso,
rectificación, supresión, oposición y demás derechos legalmente establecidos a
través del email sergio@ayudaexcel.com.

Información adicional: Encontrarás más información en la política de privacidad.




  • Posts

    • Hola! Puede alguien ayudarme a corregir esta sentencia? Son dos condiciones. Si la Celda A es igual a "Referencia 23" y la D no contiene la palabra "Almacén" entonces MsgBox "..." Lo probé de dos formas pero no hace bien el filtro, he leído que lo suyo es usar el If Not pero entonces también creo que lo aplica a lo segundo y no funciona: 1) If Cells(i, "A").Value = "Referencia 23" And Cells(i, "D").Value <> "*Almacén*" Then MsgBox.... 2) If Not Cells(i, "D").Value Like "*almacén*" And Cells(i, "A").Value = "Referencia 23" Then MsgBox … Gracias!
    • @pixelatumente, te recomiendo que rellenes los campos de tu perfil referentes al separador de argumentos y versión de Excel que usas. Con Excel 365 hay una respuesta fácil a tu consulta.
    • Gracias por tu aportación. Estoy probando añadiendo más información en la columna B pero no funciona.
    • Saludos compañeros,tengo una tabla dinamica con algunas medidas,una de ellas devuelve el ultimo vendedor que tuvo cierto cliente,el caso es que cuando filtro por vendedor,efectivamente muestra el vendedor,pero sigue mostrando los clientes que antes atendia pero que ya no,solo que en la columna ult vendedor queda la celda vacia,lo que me indica que ese cliente lo tiene actualmente otro vendedor,lo que deseo es que cuando se realice el filtro solo aparezca el vendedor con su cliente actual,sin celdas en blanco en la columna ultvendedor,en el ejemplo adjunto hay mas aclaratorias.tengo otras preguntas que estan relacionadas con el mismo archivo pero no se si es posible hacer varias preguntas en u mismo post,la otra pregunta es como puedo meter en un slicer una medida para filtrar por esa medida,en la columna estatus tengo el estatus de activo,down y bajada quiero un slicer que cuando selecione lost me aparezcan solo los clientes perdidos por ejemplo,y finalmente como puedo hacer un conteo de los clientes con los diferentes estatus por vendedor para poder hacer luego un analisis de cuantos clientes perdidos,activos o en bajada tienen cada vendedor,si debo hacer estas preguntas en otro post me disculpo y lo hare seguro,volvemos solo a la primera pregunta,si no hay lio en responder las otras preguntas se los agradezco.saludos cordiales mis estimados Maestro de pedidos 1.2.xlsx
    • Hola @Antoni, muchas gracias por la respuesta, funciona bien, pero me di cuenta de algo que tal vez no empleé término correcto. Me estoy dando cuenta que si el valor del MONTO TOTAL reflejado en la columna J varía por modificaciones que se haga en la información. El valor que se copió en la hoja CONTROL GENERAL no se actualiza. Creo que empleé mal el término copiar como valor. Debería actualizarse si CONTROL1 se modifica. Así se mantiene actualizada la información en caso de cambios. Agradecido de antemano y disculpa no haberme expresado bien.  Gracias
  • Recently Browsing

    No registered users viewing this page.

×
×
  • Create New...

Important Information

Privacy Policy