Excel Web查询以登录网站

Question

I am looking for a macro/vba code to log me into a website which is password protected, there are two password on the site. I have got some code which uses internet explorer to get me into website but it does not retrieve data, the web query browser is not logged in, I'm logged in into only internet explorer and not excel web query browser because of that I can not refresh or update data into excel using web query connections which I have already created.

Sub WebLogin()
Dim a As String
Set IE = CreateObject("InternetExplorer.Application")
With IE
    .Visible = True
    .Navigate "https://newtrade.sharekhan.com/rmmweb/login/LoginPage.jsp"
    Do Until .ReadyState = 4
        DoEvents
    Loop
    .Document.all.Item("loginid").Value = "myuserid"
    .Document.all.Item("brpwd").Value = "password1"
    .Document.all.Item("trpwd").Value = "password2"
    .Document.forms(0).submit
End With
IE.Quit
End Sub

So is there a way to change this code from using internet explorer and use excel web query browser so that it can auto log in and I just have to refresh the external connection from web which is already added into my excel sheet?

PS I am using Excel 2016 64-bit version on windows 10.

Answer 1

You need to get the cookie after logging in in order to identify yourself to the web server in the following requests. You will always need to log in first and get that variable from the browser.

After you log in using the code you posted grab the cookies you need (try re-creating what you are trying to do in IExplorer with Network Recorder in the developer tools of the browser. Then you can pass those cookies to the server in the HTTP Post request after closing IE.

Answer 2

You can use this concept to login to (almost) any website.

Dim HTMLDoc As HTMLDocument
Dim oBrowser As InternetExplorer
Sub Login_2_Website()

Dim oHTML_Element As IHTMLElement
Dim sURL As String

On Error GoTo Err_Clear
sURL = "https://www.google.com/accounts/Login"
Set oBrowser = New InternetExplorer
oBrowser.Silent = True
oBrowser.timeout = 60
oBrowser.navigate sURL
oBrowser.Visible = True

Do
' Wait till the Browser is loaded
Loop Until oBrowser.readyState = READYSTATE_COMPLETE

Set HTMLDoc = oBrowser.Document

HTMLDoc.all.Email.Value = "sample@vbadud.com"
HTMLDoc.all.passwd.Value = "*****"

For Each oHTML_Element In HTMLDoc.getElementsByTagName("input")
If oHTML_Element.Type = "submit" Then oHTML_Element.Click: Exit For
Next

' oBrowser.Refresh ' Refresh If Needed
Err_Clear:
If Err <> 0 Then
Debug.Assert Err = 0
Err.Clear
Resume Next
End If
End Sub