Excel的VBA - 如何導入從網頁文本到單個細胞

Question

Dim lastRow As Integer 
lastRow = Range("a1").End(xlDown).Row 
Dim url As String 

    For i = 2 To lastRow Step 1 
     strUrl = Range("a" & i).Value 

     With ActiveSheet.QueryTables.Add(Connection:= _ 
     "URL;https://politicsandwar.com/api/nation/id=" & strUrl, Destination:=Range("S" & i)) 
     End With 
    Next 

我想從一個特定的網站全文拉成單細胞，當我運行這個，我的屏幕灰色出去分鐘兩個實際上並沒有將任何東西放入目標單元格中​​。例如，第一行（單元格A2）將使用來自"7687"的數據。

Answer 1

添加.Refresh作爲最後一個發言的With ... End With塊中，像這樣：

For i = 2 To lastRow Step 1 
    strUrl = Range("a" & i).Value 

    With ActiveSheet.QueryTables.Add(Connection:= _ 
     "URL;https://politicsandwar.com/api/nation/id=" & strUrl, Destination:=Range("S" & i)) 
     .Refresh 
    End With 
Next 

看看this。

Answer 2

這應該做你想做的。

Sub Sample() 
    Dim ie As Object 
    Dim retStr As String 

    Set ie = CreateObject("internetexplorer.application") 

    With ie 
     .Navigate "http://www.wikihow.com/Choose-an-Email-Address" 
     .Visible = True 
    End With 

    Do While ie.readystate <> 4: Wait 5: Loop 

    DoEvents 

    retStr = ie.document.body.innerText 

    '~> Write the above to a text file 
    Dim filesize As Integer 
    Dim FlName As String 

    '~~> Change this to the relevant path 
    'Save as Text File 
    'FlName = "C:\Users\Siddharth\Desktop\Sample.Txt" 

    Range("A1").Value = retStr 

    filesize = FreeFile() 

    'Open FlName For Output As #filesize 

    'Print #filesize, retStr 
    Close #filesize 
End Sub 

Private Sub Wait(ByVal nSec As Long) 
    nSec = nSec + Timer 
    While nSec > Timer 
     DoEvents 
    Wend 
End Sub 

基於此。

Return entire page text from IE object