Web Query on Site with Login

2

I need to access a site to do a web data import, but this site needs to login and whenever I leave the worksheet and enter again I have to edit the query and connect again!

The idea was to make this connection automatically. Then I used a code to access the login page, enter 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 import macro would look like 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 this does not solve. I have to edit the query and enter manually. How do I resolve this?

    
asked by anonymous 22.07.2015 / 05:51

0 answers