2

Estoy creando una formula cual al escribir un numero llamado RTN me devulve el un nombre luego de una consulta web, por ejemplo pongo el numero 08019002275485 en la casilla RTN y me devuelve los resultados del cual necesito el nombre "EMPRESA DE CONSULTORIA EN INGIENERIA CONSULTING S DE R L"

El codigo vba es el siguiente

Function Registro(RTN As String)
   Dim IE As Object
   Dim Respuesta As String

   Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate "http://enlacertn.sar.gob.hn"
    IE.Visible = True
   While IE.busy
    DoEvents
   Wend
   IE.document.All.Item("txtCriterio").Value = RTN
   IE.document.All("btnBuscar").Click
   Application.Wait (Now + TimeValue("0:00:03"))

   Do Until IE.ReadyState = 4
    DoEvents
   Loop
   Respuesta = IE.document.getElementById("LblNombre").innertext
   Registro = Respuesta
  IE.Quit
End Function

necesito extraer el elemento Id=LblNombre pero me devulve un error la funcion

Adjunto imagenes para mayor comprension

Excel Error

Antes dela consulta

Despues de la consulta

codigo de la pagina web

Si son tan amables de indicarme donde tengo el error en la formula y de paso explicarme un poco como seria el codigo para aprender.

Gracias!

10
  • por favor mira Cómo preguntar. Las imagenes deberian estar en la pregunta. Y cual es el valor de la celda? porque el codigo parece hacer todo bien.
    – gbianchi
    el 19 ene. 2018 a las 13:21
  • Si lo lei, tratare de leerlo de nuevo para corregir los errores, en una celda pongo el numero RTN y en otra la funcion registro de manera que me devuelva el nombre que esta registrado de ese numero RTN. el 19 ene. 2018 a las 13:31
  • pero esa funcion no devuelve nada...
    – gbianchi
    el 19 ene. 2018 a las 13:32
  • Exacto, algo de la estructura del codigo de la pagina web o del codigo vba debe estar mal.. el 19 ene. 2018 a las 15:48
  • A lo que me refiero es que la funcion esta devolviendo un innertext, que vos comprobaste que estuviera bien?
    – gbianchi
    el 19 ene. 2018 a las 15:49

2 respuestas 2

2

Tienes usted que esperar a que la página se cargue con While .Busy Or .readyState < 4: DoEvents: Wend. No utilizar como una función definida por el usuario. Es ineficiente. Llamar a la función desde un sub.

Option Explicit
Public Sub test()
    Dim RTN As String
    RTN = "08019002275485"
    Activesheet.Range("A1") =  Registro(RTN)
End Sub

Function Registro(ByVal RTN As String) As String
    Dim IE As Object
    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Visible = True
        .navigate "http://enlacertn.sar.gob.hn"

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

        .document.all.item("txtCriterio").Value = RTN
        .document.all("btnBuscar").Click

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

         Registro = .document.getElementById("LblNombre").innerText
        .Quit
    End With
End Function
2

Se trata de un problema de tiempos. La función Application.Wait no está haciendo bien su trabajo porque solo funciona cuando es llamada desde un Sub/Macro. Puede estar en una función pero si llamas a esta desde una celda en la forma =Registro(A1) o desde el VBA (Ejecutar o F5) Application.Wait no realizará ningún tipo de delay, al menos programado, porque lógicamente el motor de Excel debe procesarla y eso lleva tiempo (milisegundos). Es fácil comprobar esto si ejecutamos en un Sub y en una Function el siguiente código:

MsgBox Application.Wait(Now + TimeValue("00:00:05"))

Devolverá Verdadero y Falso respectivamente. Application.Wait funcionará bien, siempre y cuando esté dentro de una Sub/Macro (Sub y Macro son exactamente lo mismo) o cuando, si está en una función, sea llamada desde una Sub/Macro.

Debido a esto se genera un error cuando llegamos a las líneas:

IE.document.All("btnBuscar").Click
Application.Wait (Now + TimeValue("0:00:03"))

Ya que tras ejecutar .Click deberiamos esperar a que el servidor encuentre el dato y sea mostrado en el navegador. Con un delay correcto, .Click devuelve perfectamente el valor y por lo tanto la función también.

Aunque lo de .Wait esté solucionado podría ocurrir, y de hecho ocurre con bastante frecuencia, que la línea:

    Set IE = CreateObject("InternetExplorer.Application")

genere un error por no haber podido crear el objeto y por consiguiente la función nos devolveria #¡VALOR!. En ese caso ya no es problema de los delays y para solucionarlo utlilizaremos On Error Goto junto con un contador para evitar un bucle cerrado.

El código siguiente funciona perfectamente aunque es posible que haya que ajustar los tiempos. Tampoco hace falta que IE.Visible sea True.
Y si sale el famoso #¡VALOR! hay que volver a ejecutar la función ya que seguro que es por culpa de IE o los Delays.

Public Function Registro(RTN As String) As String
On Error GoTo otra

Dim IE As Object
Dim v_Time As Date
Dim v_ErrorCount As Integer
v_ErrorCount = 0
    'Delay incorrecto si no se llama desde Sub
    'Application.Wait (Now + TimeValue("00:00:02"))

otra:
    If v_ErrorCount > 2 Then    'Se puede aumentar el margen
        Registro = "Error en Set IE"
        Exit Function
    End If
    v_ErrorCount = v_ErrorCount + 1
    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate "http://enlacertn.sar.gob.hn"
    IE.Visible = False

    While IE.busy
        DoEvents
    Wend

    IE.document.All.Item("txtCriterio").Value = RTN
    IE.document.All("btnBuscar").Click
    f_Delay "00:00:03" 'Si falla mucho cambiar a 4 segundos
    Registro = IE.document.getElementById("LblNombre").innertext
    IE.Quit

    'Línea que muestra los intentos. Se puede eliminar
    MsgBox "Intentos " & v_ErrorCount
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Private Function f_Delay(ByVal v_Delay As String)
    v_Time = Now
    Do While Now - v_Time < TimeValue(v_Delay)
        DoEvents
    Loop
End Function

Si vamos a utilizar un Sub para llamar a la función recuerda pasarle el dato RTN como argumento. Las siguientes funciones corren perfectamente.

Sub s_call2()

    'obj_Cell Almacena número RTN.
    Cells(obj_CellDestino) = Registro(obj_Cell.Value)

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function Registro(RTN As String) As String

Dim IE As Object
Dim Respuesta As String
Dim v_Time As Date

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate "http://enlacertn.sar.gob.hn"
    IE.Visible = False

    While IE.busy
        DoEvents
    Wend

    Application.Wait (Now + TimeValue("00:00:01"))
    IE.document.All.Item("txtCriterio").Value = RTN
    IE.document.All("btnBuscar").Click
    Application.Wait (Now + TimeValue("00:00:01"))
    Registro = IE.document.getElementById("LblNombre").innertext
    'Application.Wait (Now + TimeValue("00:00:01"))
    IE.Quit
End Function

introducir la descripción de la imagen aquí

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.