** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Access y VBA
  Mensajes nuevos Mensajes nuevos RSS - Leer web con autentificación
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoLeer web con autentificación

 Responder Responder
Autor
Mensaje
pcaceres Ver desplegable
Nuevo
Nuevo


Unido: 04/Febrero/2013
Localización: España
Estado: Sin conexión
Puntos: 12
Enlace directo a este mensaje Tema: Leer web con autentificación
    Enviado: 03/Junio/2019 a las 13:44

Hola,

 

No consigo leer una página web que requiere autentificación. ¿me podéis ayudar?

 

Gracia

Arriba
lbauluz Ver desplegable
Administrador
Administrador
Avatar

Unido: 29/Marzo/2005
Localización: Cárcel Brieva
Estado: Sin conexión
Puntos: 3350
Enlace directo a este mensaje Enviado: 03/Junio/2019 a las 16:32
Hola pcaceres

Pues como no seas un poco más específico, va a ser dificil, al menos para mi.

Dinos como lo haces, qué tienes hecho y si es posible, la dirección web en la que estás probando.

Un saludo.

Luis
Estoy en el módulo psiquiátrico de la prisión de Brieva
Arriba
pcaceres Ver desplegable
Nuevo
Nuevo


Unido: 04/Febrero/2013
Localización: España
Estado: Sin conexión
Puntos: 12
Enlace directo a este mensaje Enviado: 03/Junio/2019 a las 18:56
Hola lbauluz,
realmente no tengo mucho, siempre que lo he necesitado lo realizado con el código de abajo, pero ahora necesito autentificarme para la pagina https://trucksbook.eu/logbook/48456

Public Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare PtrSafe Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare PtrSafe Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Public Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Public Const IF_FROM_CACHE = &H1000000
Public Const IF_MAKE_PERSISTENT = &H2000000
Public Const IF_NO_CACHE_WRITE = &H4000000
Public Const BUFFER_LEN = 10000


Public Function LeeURL(sURL As String) As String
Dim sBuffer As String * BUFFER_LEN, iResult As Integer, sData As String
Dim hInternet As Long, hSession As Long, lReturn As Long
hSession = InternetOpen("vb wininet", 1, vbNullString, vbNullString, 0)
If hSession Then hInternet = InternetOpenUrl(hSession, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0)
If hInternet Then
iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
sData = sBuffer
Do While lReturn <> 0
iResult = InternetReadFile(hInternet, sBuffer, BUFFER_LEN, lReturn)
sData = sData + Mid(sBuffer, 1, lReturn)
Loop
End If
iResult = InternetCloseHandle(hInternet)
LeeURL = sData
End Function

Gracias
Arriba
lbauluz Ver desplegable
Administrador
Administrador
Avatar

Unido: 29/Marzo/2005
Localización: Cárcel Brieva
Estado: Sin conexión
Puntos: 3350
Enlace directo a este mensaje Enviado: 03/Junio/2019 a las 21:22
Prueba así


Option Explicit
Sub AccessWithPass()
    Dim msg As String
    Dim ie As Object

    Set ie = CreateObject("internetexplorer.application")
    ie.Visible = True
    ie.navigate "https://trucksbook.eu/logbook/48456"
        
    'idle while ie is busy
    Do While ie.Busy
        DoEvents
    Loop
    Application.Wait Now + TimeValue("00:00:04") ' Just in case
    
    msg = ie.Document.Body.innerhtml

    ie.Document.getElementById("email").Value = "myemail@mio.es" ' Send user
    ie.Document.getElementById("pass").Value = "MySecretPassword" ' send password
        
    MsgBox "Done!"   ' break here to test
    ie.Quit
    Set ie = Nothing
    
    DoEvents
    Exit Sub
error:
   MsgBox "Unknown Error!"
End Sub



Editado por lbauluz - 03/Junio/2019 a las 21:44
Estoy en el módulo psiquiátrico de la prisión de Brieva
Arriba
pcaceres Ver desplegable
Nuevo
Nuevo


Unido: 04/Febrero/2013
Localización: España
Estado: Sin conexión
Puntos: 12
Enlace directo a este mensaje Enviado: 03/Junio/2019 a las 22:02
Problema resuelto. Pulgares hacia arriba

Muchas gracias Luis.

Saludos.
Arriba
lbauluz Ver desplegable
Administrador
Administrador
Avatar

Unido: 29/Marzo/2005
Localización: Cárcel Brieva
Estado: Sin conexión
Puntos: 3350
Enlace directo a este mensaje Enviado: 03/Junio/2019 a las 22:24
¡A mandar!

Por cierto, la línea 
msg = ie.Document.Body.innerhtml

y la definición 

 Dim msg As String

Sobran en este ejemplo.

Cierro el hilo.
Estoy en el módulo psiquiátrico de la prisión de Brieva
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable