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"
的数据。
发布于 2017-10-11 10:33:35
在With ... End With
块中添加一个.Refresh
作为最后一条语句,如下所示:
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吧。
发布于 2017-10-28 20:24:24
这应该可以做你想要的事情。
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
基于这一点。
https://stackoverflow.com/questions/46677721
复制相似问题