Microsoft Excel 2010 Web Query Macro: Pulling Multiple Pages From One

I am looking to find some help on this Macro.. The idea is, upon execution开发者_Go百科 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

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

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"

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

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

.

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