Data from Web pull requires sign in credentials

Question

I have some code that pulls data from a website, which works correctly, my issue is that you have to sign in to the website in order to get to the data I need. Everything works great until I close and reopen the sheet. If I don't do a manual pull before running the code it pulls no data from the site. Is there a way to get it to sign in for me?

 Sub Search_People()

Dim Name_Of_Person As String
Dim URL As String
Dim Dashboard_Sheet As Worksheet
Set Dashboard_Sheet = ThisWorkbook.Sheets("Dashboard")
Dim Data_Sheet As Worksheet
Set Data_Sheet = ThisWorkbook.Sheets("Data")
Dim Data_Dump As Worksheet
Set Data_Dump = ThisWorkbook.Sheets("DataDump")
Dim X As Integer
Dim Y As Integer
Dim Last_Row As Long
Dim Email_Output As Range
Set Email_Output = Data_Dump.Range("A:XFD")
Dim Cell As Range


Application.EnableCancelKey = xlDisabled

Last_Row = Data_Sheet.Range("B3")

    For X = 1 To Last_Row
    On Error Resume Next

        Name_Of_Person = Data_Sheet.Cells(2 + X, 8)
            Application.StatusBar = "    Pulling Data for... " & Name_Of_Person
        URL = "URL;" & "https://fake.com/people/"
        URL = URL & Name_Of_Person & "%40fake.com"
            With Data_Dump.QueryTables.Add(Connection:= _
            URL, _
            Destination:=Data_Dump.Range("A1"))
             .FieldNames = True
             .RowNumbers = False
             .FillAdjacentFormulas = False
             .PreserveFormatting = True
             .RefreshOnFileOpen = False
             .BackgroundQuery = True
             .RefreshStyle = xlInsertDeleteCells
             .SavePassword = False
             .SaveData = True
             .AdjustColumnWidth = True
             .RefreshPeriod = 0
             .WebSelectionType = xlEntirePage
             .WebFormatting = xlWebFormattingNone
             .WebPreFormattedTextToColumns = True
             .WebConsecutiveDelimitersAsOne = True
             .WebSingleBlockTextImport = False
             .WebDisableDateRecognition = False
             .WebDisableRedirections = False
             .Refresh BackgroundQuery:=False


            End With
            Set Cell = Email_Output.Find("Email")
            Worksheets("Data").Cells(2 + X, 9).Value = Cell
            Data_Dump.Range("A:A").EntireColumn.Delete



    Next X
            Application.StatusBar = False
 End Sub

you can get vba to log into the website for you, see [this](http://stackoverflow.com/questions/24038230/fill-user-name-and-password-in-a-webpage-using-vba) answer for somewhere to start. — ballsy26, May 23 '16 at 23:02

score 1 · Accepted Answer · answered May 24 '16 at 16:35

The answer in the above link works perfectly.

 Sub test()
'  open IE, navigate to the desired page and loop until fully loaded
Set ie = CreateObject("InternetExplorer.Application")
my_url = ""

With ie
    .Visible = True
    .Navigate my_url
    .Top = 50
    .Left = 530
    .Height = 400
    .Width = 400

Do Until Not ie.Busy And ie.readyState = 4
    DoEvents
Loop

End With

' Input the userid and password
ie.Document.getElementById("uid").Value = ""
ie.Document.getElementById("password").Value = ""

' Click the "Search" button
ie.Document.getElementById("enter").Click

Do Until Not ie.Busy And ie.readyState = 4
    DoEvents
Loop
End Sub

score 0 · Answer 2 · answered May 27 '16 at 17:48

Please try this...

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

Also, take a look at this link.

http://vbadud.blogspot.com/2009/08/how-to-login-to-website-using-vba.html

Data from Web pull requires sign in credentials

2 Answers2