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?