來自網站的數據將變量名稱傳遞給URL但不會轉到正確的網站

Question

此代碼基本上正常工作，但由於某種原因，它所拖動的數據不會改變。在我逐步瀏覽Name_of_Person變量時，我正在通過X進行更改，並且每次創建和使用的URL都會發生更改，但它會一直插入第一個查詢中的數據。任何想法爲什麼？

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:A") 
Dim Cell As Range 

Last_Row = Data_Sheet.Cells(Data_Sheet.Rows.Count, 8).End(xlUp).Row 

    For X = 1 To Last_Row + 1 
     Name_Of_Person = Data_Sheet.Cells(2 + X, 8) 
     URL = "URL;" & "https://hn.com/people/" 
     URL = URL & Name_Of_Person & "%40.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 

      Set Cell = Email_Output.Find("Email") 
      Worksheets("Data").Cells(2 + X, 9).Value = Cell 
      End With 
      Data_Dump.Columns("A:A").Select 
      Selection.Delete Shift:=xlToLeft 



    Next X 

End Sub 

Answer 1

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.Cells(Data_Sheet.Rows.Count, 8).End(xlUp).Row 

    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://site/" 
     URL = URL & Name_Of_Person & "site.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 

此代碼解決了所有上述問題。