Web拉取的数据需要login凭据

我有一些代码，从一个网站的数据，这是正常的工作，我的问题是，你必须login到网站，以获得我需要的数据。 一切都很好，直到我closures并重新打开表单。 如果我在运行代码之前没有进行手动拉取，那么它将不会从站点中获取数据。 有没有办法让它login我？

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 

Answer 1

上面的链接的答案完美的作品。

  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 

Answer 2

请试试这个…

 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 = "[e-mail]" 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 

另外，看看这个链接。

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