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

如何将文本从网页导入单个单元格

2 个答案: