Макрос веб-запроса Microsoft Excel 2010: извлечение нескольких страниц из одного

Question

Мне нужна помощь по этому макросу. Идея состоит в том, что при запуске макрос извлекает данные с веб-страницы (IE http://www.link.com/id=7759) и помещает их, скажем, в Sheet2, а затем открывает вверх на страницу 2, и поместите ее прямо под данными страницы 1 на листе 2 .... И так далее, и так далее, пока не будет установлен номер страницы. В идеале, я хотел бы просто потянуть следующее по порядку;

Название художник Тип Размер бумаги Размер изображения Розничный приз Количество

И, кроме того, идеальным является размещение в надлежащих столбцах и строках по 4 и 8 строк вниз (столбцы поперек, как на веб-странице).

Любая помощь по этому вопросу будет очень, очень признателен. Я провел некоторое исследование и нашел похожие макросы, к сожалению, мне не повезло заставить их работать на меня. В основном VB также не проходит.

Немного полезной информации (возможно) Я понял это, когда пытался написать свою собственную, может быть, это спасет тех, кто когда-нибудь поможет ...

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

Это таблицы для каждого предмета, который я хочу поместить в очередь ...

Answer 1

Вот пример метода, который поможет вам

На основании нескольких предположений

• Рабочая книга содержит лист для хранения данных запроса, который называется «Запрос»

• Рабочая тетрадь содержит лист для размещения данных под названием «AllData»

• Все старые данные удаляются при запуске макроса

• Я думаю, вам нужно включить Таблицу 7 в qyuery

• Страницы для обработки жестко запрограммированы как 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