Web Query at Login Site

Asked

Viewed 865 times

2

I need to access a site to make an import of data from the web, but this site needs login and whenever I leave the spreadsheet and enter again I have to edit the query and connect again!

The idea was to make this connection automatically. So I used a code to access the login page, log in and go to the page where the data is. see:

Sub LoginPilotoGPRO()
    Dim vUsuario As String
    Dim vSenha As String
    Dim vURLHome, vURLPiloto As String
    Dim objIE As New InternetExplorer 'Referencie "Microsoft Internet Controls"

    'Abre o IE
    objIE.Visible = True


    'Define os dados de acesso e link da página de login
    vUsuario = FrmLogin.txtUsuario
    vSenha = FrmLogin.txtSenha
    vURLHome = "http://www.gpro.net/br/gpro.asp"
    vURLPiloto = "http://www.gpro.net/br/" & Sheets("Perfil do Piloto").Range("f12").Value

    'Navega até o link informado
    objIE.Navigate vURLHome

    'Espera até que o IE carregue por completo
    Do Until objIE.ReadyState = READYSTATE_COMPLETE
        DoEvents
    Loop

    On Error GoTo Erro
    'Nessa parte você deve conhecer a propriedade "name" dos elementos input do site que irá logar
    objIE.Document.all("textLogin").innerText = vUsuario
    objIE.Document.all("textPassword").innerText = vSenha

    'Nessa parte você deve informar o nome (propriedade name) do formulário a ser submetido
    objIE.Document.all("Form1").submit

    objIE.Navigate vURLPiloto
    Do Until objIE.ReadyState = READYSTATE_COMPLETE
        DoEvents
    Loop

    Call Macros.ImportarPerfilPiloto

    objIE.Quit
    Unload FrmLogin

The macro of the import would be this:

Sub ImportarPerfilPiloto()
    Dim vURLfull, vURLperfil As String

    vURLfull = Sheets("Perfil do Piloto").Range("b12").Value
    vURLperfil = Sheets("Perfil do Piloto").Range("f12").Value

    Sheets("Perfil do Piloto").Select

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & vURLfull, Destination:=Range( _
        "$B$18"))
        '.CommandType = 0
        .Name = vURLperfil
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

End Sub

Unfortunately that doesn’t solve it. I have to edit the query and log in manually. How to resolve this?

No answers

Browser other questions tagged

You are not signed in. Login or sign up in order to post.