how to use QueryTables with multiple Web Pages

[Chadz]

Hi I'm trying to query a web site and export the data to a single sheet in Excel. I've used the record macro function in Excel (2007) and come up with the following but I want to query over 20 pages from this site and wondered if there was any way in looping this macro to do the hard work for me;

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.futwiz.com/en/players", Destination:=Range("$A$1"))
.Name = "players_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=27
Range("A52").Select

On the second page the URL changes to;

URL;FIFA 14 Ultimate Team Players - FUTWIZ

and the .Name field changes to;

.Name = "players?page=1_1"

and on the 3rd page I get;

URL;FIFA 14 Ultimate Team Players - FUTWIZ

and..

.Name = "players?page=2"

Any advice for a novice much appreciated.

 

[John_w]

Try this. Just change the For loop - currently it imports the first 6 pages.

Public Sub Import_All_Players()
    
    Dim page As Integer
    Dim destCell As Range
    
    With ActiveSheet
        Set destCell = .Range("A1")
        For page = 0 To 5
            With .QueryTables.Add(Connection:="URL;http://www.futwiz.com/en/players?page=" & page, Destination:=destCell)
                .Name = "players_1"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = False
                .RefreshPeriod = 0
                .WebSelectionType = xlAllTables
                .WebFormatting = xlWebFormattingNone
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            Set destCell = destCell.Offset(.QueryTables(1).ResultRange.Rows.Count, 0)
            .QueryTables(1).Delete
        Next
    End With
    
End Sub

Please use CODE tags when posting VBA code, like this:
[CODE]
VBA code here
[/CODE]

 

[Chadz]

Cheers John_W - that worked a treat, couldn't figure out the syntax for the loop but that looks simple enough now. Also now I know how to work with destCell. Slight hiccup now is that the Macro brings back the field names for each page when I only need it for the first page - so I'm guessing I just record the macro with the field names already entered and then change the .FieldNames = True to .FieldNames = False. And finally any idea how I would run this macro every 30 minutes and output the data to a new worksheet?

 

[John_w]

I don't think the FieldNames argument affects the number of rows imported.

Try this, which deletes the unwanted headings rows after the first page. This time I've used .Cells(row,"A") for the Destination argument instead of the destCell range variable to make it easier to delete the unwanted rows.

Public Sub Import_All_Players2()
    
    Dim page As Integer
    Dim row As Long
    
    With ActiveSheet
        .Cells.Clear
        row = 1
        For page = 0 To 5
            With .QueryTables.Add(Connection:="URL;http://www.futwiz.com/en/players?page=" & page, Destination:=.Cells(row, "A"))
                .Name = "players_1"
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = False
                .RefreshPeriod = 0
                .WebSelectionType = xlAllTables
                .WebFormatting = xlWebFormattingNone
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            If row > 1 Then .Cells(row, "A").EntireRow.Delete
            row = row + .QueryTables(1).ResultRange.Rows.Count
            .Cells(row, "A").Select
            .QueryTables(1).Delete
            DoEvents
        Next
    End With
    
End Sub

To run the code every 30 minutes, call it with Application.OnTime and repeat the timer - see Pearson Software Consulting. Record a macro with you adding a new sheet to generate the VBA and combine it with the above code.