Created Web Query to import data from a webpage table. Now how can I make it loop through many URLs?

d0rian

Active Member
Joined
May 30, 2015
Messages
313
Office Version
  1. 365
My file has 2 sheets: "URLs" and "Sheet1". In column A of URLs, I have a few dozen URLs listed. I manually recorded a macro of me running a web query to go fetch the data on a page and paste it to cell A1 of "Sheet1" (below). Now how do I instruct Excel to run through every URL in column A of the "URLs" sheet and so the same?
Ideally, I'd like it all to import to the same sheet ("Sheet1"), with each successive import starting on the first empty row of Sheet1 one below the next. FYI: every page I'm pulling the data table from has the same format (it's stock data for different symbols) so it's the same # of columns...but there will be different # of ROWS of data on each b/c some have way more lines of data than others...

Code:
Sub test_url()    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://www.m-x.ca/nego_cotes_en.php?symbol=BHC", Destination:=Range( _
        "$A$1"))
        .Name = "nego_cotes_en.php?symbol=BHC"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Try with this

In your urls sheet the urls should start in cell A2 and they should be like this: https://www.m-x.ca/nego_cotes_en.php?symbol=BHC

Code:
Sub test_url()
    Dim h1 As Worksheet, h2 As Worksheet
    Dim u1 As Long, u2 As Long
    Dim MyUrl As String
    '
    Application.ScreenUpdating = False
    Application.StatusBar = False
    Set h1 = Sheets("URLs")     'origin
    Set h2 = Sheets("sheet1")   'destiny
    '
    h2.Cells.ClearContents
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To u1
        MyUrl = h1.Cells(i, "A").Value
        Application.StatusBar = "import data : " & i - 1 & " of : " & u1 - 1
        u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
        With h2.QueryTables.Add(Connection:="URL;" & MyUrl, Destination:=h2.Range("A" & u2))
            .Name = "nego_cotes_en.php?symbol=BHC"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    Next
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub
 
Upvote 0
Thanks for this, Dante -- it works well; I made a couple small tweaks (specifically, instead of importing the ENTIRE page of data -- which includes a bunch of unnecessary rows -- I found I could just import the second table on the page (which has all the data I need), though it led to an interesting problem: the data is all imported, each URL stacked nicely below the previous one, to Sheet1 BUT there's no way of telling which data came from which URL, because the NAME or TICKER of the company isn't in the table(!) E.g. see rows 127 - 130 in this pic:

9IrjyIH.jpg


Row 127 is the last row of imported data from my first symbol (BHC, retrieved from the URL in cell A2 of the URLs sheet, and row 128 is the first row of imported data from my second symbol (CRON) in cell A3 of the URLs sheet. BUT there's no way to tell in the finished sheet of data what block of imported data came from which symbol/URL.

TLDR: I'm wondering if it's possible to add in the first empty column (P) to the right of the imported data just which symbol (or just the complete URL from which I can easily extract the symbol) the data to the left of it came from.
(The only other solution I could come up with is -- assuming the data is imported in the same order I have my URLs listed in the URLs sheet -- I could just manually run a formula in column P that will pull the next symbol from my list each time it sees a value of "Call" in column A of the imported table...not too difficult I guess, but thought there might be a way to get the import code to do it for me.)

Here's the code I have at this pt:
Code:
Sub looper()    Dim h1 As Worksheet, h2 As Worksheet
    Dim u1 As Long, u2 As Long
    Dim MyUrl As String
    '
    Application.ScreenUpdating = False
    Application.StatusBar = False
    Set h1 = Sheets("URLs")     'origin
    Set h2 = Sheets("sheet1")   'destiny
    '
    h2.Cells.ClearContents
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To u1
        MyUrl = h1.Cells(i, "A").Value
        Application.StatusBar = "import data : " & i - 1 & " of : " & u1 - 1
        u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
        With h2.QueryTables.Add(Connection:="URL;" & MyUrl, Destination:=h2.Range("A" & u2))
            .Name = "nego_cotes_en.php?symbol=BHC"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlOverwriteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = False
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "2"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
    Next
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub
 
Upvote 0
Try:

Code:
Sub test_url()
    Dim h1 As Worksheet, h2 As Worksheet
    Dim u1 As Long, u2 As Long
    Dim MyUrl As String
    '
    Application.ScreenUpdating = False
    Application.StatusBar = False
    Set h1 = Sheets("URLs")     'origin
    Set h2 = Sheets("sheet1")   'destiny
    '
    h2.Cells.ClearContents
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To u1
        MyUrl = h1.Cells(i, "A").Value
        Application.StatusBar = "import data : " & i - 1 & " of : " & u1 - 1
        u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
        With h2.QueryTables.Add(Connection:= _
            "URL;" & MyUrl, Destination:=h2.Range("A" & u2))
            .Name = "nego_cotes_en.php?symbol=BHC"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
        u3 = h2.Range("A" & Rows.Count).End(xlUp).Row
        h2.Range("P" & u2 & ":P" & u3).Value = MyUrl
    Next
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub
 
Upvote 0
Bumping this old thread, because the code above works well for me, BUT I'm now using it to pull data from a different domain where I have an account, and -- importantly -- the data I want to pull into Excel is ONLY displayed if I'm logged in to my account...otherwise a 'not logged in' message appears at the URL. Is there any way I can amend the code to LOG IN to my account (if the query determines that I'm not logged in?)

The 'workaround' I currently use is a little crude: I first use the WEB QUERY TOOL to open the Excel 2007 built-in "browser" that I use to navigate to the site I'm pulling data from, and then I log in using my username/pw within Excel's browser...then I can close the browser. If I go through those steps, then when I run the code, Excel apparently "sees" that I'm logged into the domain it's pulling data from. I essentially just want to do all of this without manually opening the Web Query tool/browser and logging in...so want to know if I can accomplish this via my VBA code...
 
Upvote 0

Forum statistics

Threads
1,223,898
Messages
6,175,274
Members
452,628
Latest member
dd2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top