** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Tus Funciones Favoritas & Aportaciones & Artí­culos
  Mensajes nuevos Mensajes nuevos RSS - API: Capturar código HTML de una WEB
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoAPI: Capturar código HTML de una WEB

 Responder Responder
Autor
Mensaje
buho Ver desplegable
Administrador
Administrador
Avatar
Abuelo FELIZ, nieto desesperado

Unido: 10/Abril/2004
Localización: Valladolid
Estado: Sin conexión
Puntos: 11321
Enlace directo a este mensaje Tema: API: Capturar código HTML de una WEB
    Enviado: 10/Agosto/2013 a las 00:37
Ayer salió esta pregunta en el foro.
Copio aquí el procedimiento que permite hacer esto, mas que nada para que quede ya escrito y recogido en algún sitio.
En este caso, deposito los resultados de la captura HTML en un fichero de texto (Se podría hacer igual copiandolo a un campo Memo de una tabla)
Ahí va el codigo:

Option Explicit
Const scUserAgent = "Capturando Pagina Web"
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_FLAG_RELOAD = &H80000000
Private Declare Function InternetOpen Lib "wininet" Alias _
    "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, _
    ByVal sProxyName As String, ByVal sProxyBypass As String, _
    ByVal lFlags As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" ( _
    ByVal hInet As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet" ( _
    ByVal hFile As Long, ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetOpenUrl Lib "wininet" Alias _
    "InternetOpenUrlA" (ByVal hInternetSession As Long, _
    ByVal lpszUrl As String, ByVal lpszHeaders As String, _
    ByVal dwHeadersLength As Long, ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long
Sub GrabaFichero(StrURL As String)
    Dim hOpen As Long, hFile As Long, sBuffer As String, Ret As Long
    Dim NumeroArchivo As Long
    sBuffer = Space(75000)
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, _
        vbNullString, vbNullString, 0)
    'Abre la Url
    hFile = InternetOpenUrl(hOpen, StrURL, vbNullString, ByVal 0&, _
        INTERNET_FLAG_RELOAD, ByVal 0&)
    InternetReadFile hFile, sBuffer, 100000, Ret
    InternetCloseHandle hFile
    InternetCloseHandle hOpen
 'graba ls resultados, por ejemplo, a un fichero de texto:
 NumeroArchivo = FreeFile
 Open CurrentProject.Path & "\mifichero.txt" For Append As _
     #NumeroArchivo
 Print #NumeroArchivo, "*****Capturada por el Buho******" & vbCrLf & sBuffer
 Close #NumeroArchivo
End Sub
 
'probemos los resultados:
Sub prueba()
 GrabaFichero "http://www.mvp-access.es/curso.htm"
End Sub
Por fin he hecho algo bueno, ser abuelo ¡y porque no lo he hecho yo!
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable