vba Microsoft Excel 2010 Web 查询宏：从一个页面拉出多个页面
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5839454/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Microsoft Excel 2010 Web Query Macro: Pulling Multiple Pages From One
提问by Leaum
I am looking to find some help on this Macro.. The idea is, upon execution the Macro will pull The Data from a Web Page (I.E http://www.link.com/id=7759) and place it into let's say Sheet2, and then Open up Page 2, and place it right below Page 1's Data in Sheet 2.... And So on and So on until a set Page Number.. Ideally I would like it just to pull The following in order;
我正在寻找有关此宏的一些帮助.. 想法是，在执行时，宏将从网页（IE http://www.link.com/id=7759）中提取数据并将其放入让我们说Sheet2，然后打开第 2 页，并将其放在第 2 页中第 1 页的数据正下方....依此类推，直到设置页码.. 理想情况下，我希望它只是按顺序拉以下内容；
Title Artist Type Paper Size Image Size Retail Prize Quantity
标题 艺术家类型 纸张尺寸 图像尺寸 零售奖品数量
And further more it is ideal that is placed in proper columns and rows of 4 and 8 Rows down(Columns Across just like in the web page).
而且更理想的是放置在适当的列和 4 行和 8 行的行中（就像在网页中一样跨列）。
Any help on this would be greatly, greatly appreciated. I have done some research and found similar macros, sadly have had no luck getting them to work for me. Mainly VB's fail to go through as well.
对此的任何帮助将不胜感激。我做了一些研究并发现了类似的宏，遗憾的是没有运气让它们对我来说有效。主要是 VB 也没有通过。
Bit of useful info (maybe) I figured this out when I was trying to write my own, maybe it will save who ever helps some time..
一些有用的信息（也许）我在尝试自己编写时发现了这一点，也许它可以节省谁帮助过一些时间..
.WebTables = "8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38"
Those are the tables for each item I want to put into the Que...
这些是我想放入 Que 中的每个项目的表格...
回答by chris neilsen
Here's a sample method to get you going
这是一个让你开始的示例方法
Based on a few assumptions
基于一些假设
Workbook contains a Sheet to hold query data called "Query"
Workbook contains a Sheet to put the data in called "AllData"
All old data is removed on running the macro
I think you need to include Table 7 in the qyuery
Pages to process is hard coded as
For Pg = 1 To 1, change this to suit
工作簿包含一个工作表来保存名为“查询”的查询数据
工作簿包含一个工作表，用于将数据放入名为“AllData”
运行宏时删除所有旧数据
我认为您需要在 qyuery 中包含表 7
要处理的页面被硬编码为
For Pg = 1 To 1，更改它以适应
.
.
Sub QueryWebSite()
Dim shQuery As Worksheet, shAllData As Worksheet
Dim clData As Range
Dim qts As QueryTables
Dim qt As QueryTable
Dim Pg As Long, i As Long, n As Long, m As Long
Dim vSrc As Variant, vDest() As Variant
' setup query
Set shQuery = ActiveWorkbook.Sheets("Query")
Set shAllData = ActiveWorkbook.Sheets("AllData")
'Set qt = shQuery.QueryTables(1)
On Error Resume Next
Set qt = shQuery.QueryTables("Liebermans")
If Err.Number <> 0 Then
Err.Clear
Set qt = shQuery.QueryTables.Add( _
Connection:="URL;http://www.liebermans.net/productlist.aspx?id=7759&page=1", _
Destination:=shQuery.Cells(1, 1))
With qt
.Name = "Liebermans"
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End If
On Error GoTo 0
i = InStr(qt.Connection, "&page=")
' clear old data
shAllData.UsedRange.ClearContents
shAllData.Cells(1, 1) = "Title"
shAllData.Cells(1, 2) = "Artist"
shAllData.Cells(1, 3) = "Type"
shAllData.Cells(1, 4) = "Paper Size"
shAllData.Cells(1, 5) = "Image Size"
shAllData.Cells(1, 6) = "Price"
shAllData.Cells(1, 7) = "Quantity"
m = 0
ReDim vDest(1 To 10000, 1 To 7)
For Pg = 1 To 1
' Query Wb site
qt.Connection = Left(qt.Connection, i + 5) & Pg
qt.Refresh False
' Process data
vSrc = qt.ResultRange
n = 2
Do While n < UBound(vSrc, 1)
If vSrc(n, 1) <> "" And vSrc(n - 1, 1) = "" Then
m = m + 1
vDest(m, 1) = vSrc(n, 1)
End If
If vSrc(n, 1) Like "Artist:*" Then vDest(m, 2) = Trim(Mid(vSrc(n, 1), 8))
If vSrc(n, 1) Like "Type:*" Then vDest(m, 3) = Trim(Mid(vSrc(n, 1), 6))
If vSrc(n, 1) Like "Paper Size:*" Then vDest(m, 4) = Trim(Mid(vSrc(n, 1), 12))
If vSrc(n, 1) Like "Image Size:*" Then vDest(m, 5) = Trim(Mid(vSrc(n, 1), 12))
If vSrc(n, 1) Like "Retail Price:*" Then vDest(m, 6) = Trim(Mid(vSrc(n, 1), 14))
If vSrc(n, 1) Like "Quantity in stock:*" Then vDest(m, 7) = Trim(Mid(vSrc(n, 1), 19))
n = n + 1
Loop
Next
' Put data in sheet
shAllData.Cells(2, 1).Resize(m, 7) = vDest
End Sub
