Web query for password protected site

[jlecl033]

Hello all,

I am trying to create a macro that fetches information from a password protected site. I am getting error 438 but don't know how to fix it. At the moment, I am unable to automate the log in process.

I tried checking the page's source code for the property but I'm not sure what I'm looking for.

Here's my code at the moment.

Private Sub WebQuery()
Const READYSTATE_COMPLETE As Long = 4
Dim x As Integer
Dim UserName1 As String
Dim Password1 As String
UserName1 = InputBox("Enter your EnergyStar Portfolio Manager username")
Sheet1.Range("A78") = UserName1
Password1 = InputBox("Enter your EnergyStar Portfolio Manager password")
Sheet1.Range("A79") = Password1
URL = "http://www.energystar.gov/index.cfm?c=evaluate_performance.bus_portfoliomanager"
Set ie = Sheet1.WebBrowser1
ie.Visible = 1
DoEvents
ie.Navigate URL
Do Until ie.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
With ie.Document
.Item("htmuserid").Value = Sheet1.Range("A78")
.Item("htmpassword").Value = Sheet1.Range("A79")
.submit
End With
Do Until ie.ReadyState = READYSTATE_COMPLETE
DoEvents
Loop
'Application.Wait Now + TimeValue("00:00:05")
'HTMLdata = ie.Document.documentelement.innertext
'HTMLdata = VBA.Split(HTMLdata, Chr(13)) 'change the split as required CHR(13) is for carriage return.
'For x = 0 To UBound(HTMLdata)
'Sheet1.Range("A" & (x + 1)) = HTMLdata(x)
'Next x
End Sub


Thanks

 

[jlecl033]

allright, I did figure out the password and login steps with the help of other people's question in this forum. Now my problem is copying the information I need in my excel document. I am trying 2 different ways at the moment: one gets error 91 and the other error 1004.

Here is my code at this moment

Sub GoToWebSiteAndPlayAround()

Dim appIE As InternetExplorer
Dim sURL As String
Dim UserN As Variant, PW As Variant
Dim Element As HTMLButtonElement
Dim btnInput As MSHTML.HTMLInputElement
Dim ElementCol As MSHTML.IHTMLElementCollection
Dim Link As MSHTML.HTMLAnchorElement
Dim strCountBody As String
Dim lStartPos As Long
Dim lEndPos As Long
Dim TextIWant As String
Dim UserName1 As String
Dim Password1 As String

Application.ScreenUpdating = False

Set appIE = New InternetExplorer

sURL = "http://www.energystar.gov/index.cfm?c=evaluate_performance.bus_portfoliomanager"

With appIE
    .Navigate sURL
    ' uncomment the line below if you want to watch the code execute, or for debugging
   .Visible = True
End With

' loop until the page finishes loading
Do While appIE.Busy
Loop


' enter username in textboxes
UserName1 = InputBox("Enter your EnergyStar Portfolio Manager username")
Sheet1.Range("R1") = UserName1
With appIE.Document.all
.Item("userid").Value = Sheet1.Range("R1")
End With

' enter password in textboxes
Password1 = InputBox("Enter your EnergyStar Portfolio Manager password")
Sheet1.Range("R2") = Password1
With appIE.Document.all
.Item("password").Value = Sheet1.Range("R2")
End With

' click 'Submit' button
Set ElementCol = appIE.Document.getElementsByTagName("INPUT")

For Each btnInput In ElementCol
    If btnInput.Value = "Login" Then
        btnInput.Click
        Exit For
    End If
Next btnInput

' loop until the page finishes loading
Do While appIE.Busy
Loop

ActiveWorkbook.Save
Sheets("Facilities").Range("A37") = appIE.Document.all.Item("10").Table
' grab the whole screen & paste into Excel
'appIE.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DONTPROMPTUSER
'appIE.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT

'Sheets("Facilities").Select
'Range("A37").Select
'ActiveSheet.Paste

' click a button on the next page
Set ElementCol = appIE.Document.getElementsByTagName("INPUT")

For Each btnInput In ElementCol
   If btnInput.Value = "2" Then
      btnInput.Click
       Exit For
   End If
Next btnInput

' loop until the page finishes loading
Do While appIE.Busy
Loop

ActiveWorkbook.Save

' grab the whole screen & paste into Excel
appIE.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DONTPROMPTUSER
appIE.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT

Sheets("Energy use").Select
Range("A37").Select
ActiveSheet.Paste

' destroy variables and end
'Application.ScreenUpdating = True
'Set UserN = Nothing
'Set PW = Nothing
'Set ElementCol = Nothing
'Set appIE = Nothing
End Sub

thanks

 

[jlecl033]

The goals of this macro is :

1. enter the username and password, and press login
2. select the relevant data (table 10) or the whole page
3. copy the data on an excel worksheet, in a specified cel
4. change web page by selecting in a dropdown menu and do the same process for every choices.

At this point, the first and second steps work every time. The third point works about a quarter of the time and the last step never works.
here's the code:

Sub GoToWebSiteAndPlayAround()

Dim appIE As InternetExplorer
Dim sURL As String
Dim Element As HTMLButtonElement
Dim btnInput As MSHTML.HTMLInputElement
Dim ElementCol As MSHTML.IHTMLElementCollection
Dim Link As MSHTML.HTMLAnchorElement
Dim strCountBody As String
Dim lStartPos As Long
Dim lEndPos As Long
Dim TextIWant As String
Dim UserName1 As String
Dim Password1 As String

Application.ScreenUpdating = False

Set appIE = New InternetExplorer

sURL = "http://www.energystar.gov/index.cfm?c=evaluate_performance.bus_portfoliomanager"

With appIE
    .Navigate sURL
    ' uncomment the line below if you want to watch the code execute, or for debugging
   .Visible = True
End With

' loop until the page finishes loading
Do While appIE.Busy
Loop


' enter username in textboxes
'UserName1 = InputBox("Enter your EnergyStar Portfolio Manager username")
'Sheet1.Range("R1") = UserName1
With appIE.Document.all
.Item("userid").Value = "vvvvvv"
End With

' enter password in textboxes
'Password1 = InputBox("Enter your EnergyStar Portfolio Manager password")
'Sheet1.Range("R2") = Password1
With appIE.Document.all
.Item("password").Value = "gggggg"
End With

' click 'Submit' button
Set ElementCol = appIE.Document.getElementsByTagName("INPUT")

For Each btnInput In ElementCol
    If btnInput.Value = "Login" Then
        btnInput.Click
        Exit For
    End If
Next btnInput

' loop until the page finishes loading
Do While appIE.Busy
Loop

'grab the facilities information
ActiveWorkbook.Save
appIE.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DONTPROMPTUSER
appIE.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
ThisWorkbook.Sheets("Facilities").Range("A37").Select
ActiveSheet.Paste

' change page
appIE.Document.all.getElementsByTagName("pv_id").Value = "2"


' loop until the page finishes loading
Do While appIE.Busy
Loop

'grab the energy use information
ActiveWorkbook.Save
appIE.ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DONTPROMPTUSER
appIE.ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
ThisWorkbook.Sheets("Energy use").Range("A37").Select
ActiveSheet.Paste

' destroy variables and end
Application.ScreenUpdating = True
Set UserName1 = Nothing
Set Password1 = Nothing
Set ElementCol = Nothing
Set appIE = Nothing

End Sub

 

[John_w]

It's difficult to help you without seeing the specific web page, and I don't want to register on that site, but try replacing all occurrences of:

Do While appIE.Busy
Loop

with:

Do While appIE.Busy And appIE.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop

For example, this code works with the link you provided:

'Requires reference to Microsoft Internet Controls

Option Explicit

Public Sub CopyWebPage()

    Dim IE As InternetExplorer
    
    Set IE = New InternetExplorer
    
    With IE
        .Visible = True
        .Navigate "http://www.energystar.gov/index.cfm?c=evaluate_performance.bus_portfoliomanager"

        While .busy Or .ReadyState <> READYSTATE_COMPLETE
            DoEvents
        Wend
    
        'Copy the whole page
        
        .ExecWB OLECMDID_SELECTALL, OLECMDEXECOPT_DONTPROMPTUSER
        .ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT

        'Paste it to B2 on the active sheet
        
        With ActiveSheet
            .Cells.ClearContents
            .Range("B2").Select
            .Paste
        End With
        
        .Quit
    End With
    
    Set IE = Nothing
    
End Sub

 

[jlecl033]

[SOLVED] Web query for password protected site

thanks. it worked like a charm

 

[John_w]

Glad it works now, though I got the logic for the wait loop wrong; it should be:

Do While appIE.Busy Or appIE.ReadyState <> READYSTATE_COMPLETE
DoEvents
Loop

which matches the wait loop in my code: loop while IE is busy or its ready state is not complete.