Excel 打印标题从一个位置导入到另一个位置
我创建了一个vba脚本来解析不同帖子的Excel 打印标题从一个位置导入到另一个位置,excel,vba,web-scraping,queryselector,Excel,Vba,Web Scraping,Queryselector,我创建了一个vba脚本来解析不同帖子的标题,以及来自网站的这些帖子的编辑状态。我现在想做的是让我的脚本从它的登录页解析标题,但在打印编辑状态的同时打印标题。我不希望为此任务创建两个sub。我甚至不知道这在vba中是否可行。但是,如果有任何不清楚的地方,请查看我脚本中的评论 Sub ImportTitleFromAnotherLocation() Const LINK$ = "https://stackoverflow.com/questions/tagged/web-scraping"
标题
,以及来自网站的这些帖子的编辑状态
。我现在想做的是让我的脚本从它的登录页解析标题
,但在打印编辑状态
的同时打印标题
。我不希望为此任务创建两个sub。我甚至不知道这在vba中是否可行。但是,如果有任何不清楚的地方,请查看我脚本中的评论
Sub ImportTitleFromAnotherLocation()
Const LINK$ = "https://stackoverflow.com/questions/tagged/web-scraping"
Const prefix$ = "https://stackoverflow.com"
Dim Http As New XMLHTTP60, Html As New HTMLDocument
Dim editInfo As Object, I&, targetUrl$, postTile$
With Http
.Open "GET", LINK, False
.send
Html.body.innerHTML = .responseText
End With
With Html.querySelectorAll(".summary .question-hyperlink")
For I = 0 To .Length - 1
postTitle = .item(I).innerText 'I like this line to be transferred to the location below
targetUrl = Replace(.item(I).getAttribute("href"), "about:", prefix)
With Http
.Open "GET", targetUrl, False
.send
Html.body.innerHTML = .responseText
End With
R = R + 1: Cells(R, 1) = postTitle 'here I wish to use the above line like this
Set editInfo = Html.querySelector(".user-action-time > a")
If Not editInfo Is Nothing Then
Cells(R, 2) = editInfo.innerText
End If
Next I
End With
End Sub
您正在覆盖循环中的html文档。一个简单的方法是使用第二个htmldocument变量。更详细的方法是在循环之前存储标题,例如在附加循环期间存储在数组中,然后使用i变量索引到该数组中,以在现有循环期间检索每个标题
Sub ImportTitleFromAnotherLocation()
Const LINK$ = "https://stackoverflow.com/questions/tagged/web-scraping"
Const prefix$ = "https://stackoverflow.com"
Dim Http As New XMLHTTP60, Html As New HTMLDocument, Html2 As New HTMLDocument
Dim editInfo As Object, I&, targetUrl$, postTile$
Dim postTitle As String, r As Long
With Http
.Open "GET", LINK, False
.send
Html.body.innerHTML = .responseText
End With
With Html.querySelectorAll(".summary .question-hyperlink")
For I = 0 To .Length - 1
postTitle = .item(I).innerText 'I like this line to be transferred to the location below
targetUrl = Replace$(.item(I).getAttribute("href"), "about:", prefix)
With Http
.Open "GET", targetUrl, False
.send
Html2.body.innerHTML = .responseText
End With
r = r + 1: ActiveSheet.Cells(r, 1) = postTitle 'here I wish to use the above line like this
Set editInfo = Html2.querySelector(".user-action-time > a")
If Not editInfo Is Nothing Then
ActiveSheet.Cells(r, 2) = editInfo.innerText
End If
Next I
End With
End Sub