Webプルからのデータにサインインクレデンシャルが必要です

Question

正しく動作するウェブサイトからデータを取得するコードがあります。私の問題は、必要なデータにアクセスするためにウェブサイトにサインインする必要があることです。シートを閉じてもう一度開くまで、すべてがうまくいきます。コードを実行する前に手動でプルを実行しないと、サイトからデータが取得されません。私にサインインする方法はありますか？

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 = "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 

...これを試してみてください。

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