Microsoft Excel 2010 Web查询宏：从一个拉取多个页面 [英] Microsoft Excel 2010 Web Query Macro: Pulling Multiple Pages From One

问题描述

我正在寻找这个宏的一些帮助..这个想法是，在执行宏将从Web页面拉取数据（IE http://www.link.com/id=7759 ），并将其放在我们说的Sheet2，然后打开第2页，并将其放在第1页的数据表2 ....等等，直到一个设置的页数..理想情况下，我只想拉下列顺序;

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;

标题
艺术家
类型
纸张尺寸
图片尺寸
零售奖
数量

Title Artist Type Paper Size Image Size Retail Prize Quantity

还有更多理想的是放置在适当的列和行的4和8行（列在横向就像在网页中）。

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).

任何帮助，这将是非常大的，不胜感激。我做了一些研究，发现了类似的宏，遗憾的是没有运气让他们为我工作。主要是VB无法通过。

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.

有用的信息位（也许）当我试图写我自己的时候，我想出了这一点，也许会保存谁帮助一段时间..

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"

这些是我要放入Que的每个项目的表...

Those are the tables for each item I want to put into the Que...

推荐答案

这是一个让你走路的示例方法

Here's a sample method to get you going

根据几个假设

• 工作簿包含一个表格，用于保存称为查询的查询数据

• Workbook contains a Sheet to hold query data called "Query"

包含用于将数据放入AllData的工作表

Workbook contains a Sheet to put the data in called "AllData"

运行宏时，所有旧数据都将被删除

All old data is removed on running the macro

我想您需要在qyuery中包含表7

I think you need to include Table 7 in the qyuery

要处理的页面是硬编码为 Pg = 1至1 ，将其更改为适合

Pages to process is hard coded as For Pg = 1 To 1 , change this to suit

。

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

这篇关于Microsoft Excel 2010 Web查询宏：从一个拉取多个页面的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！