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

d0rian

Board Regular
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
 

DanteAmor

Well-known Member
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
 

d0rian

Board Regular
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:



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
 

DanteAmor

Well-known Member
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
 

d0rian

Board Regular
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...
 

Some videos you may like

This Week's Hot Topics

  • Get External Data (long shot question!)
    This is likely a long shot but I am wondering if it is at all possible for Excel to somehow 'change' the contents of a URL that is being linked to...
  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • Cell Formatting
    Good Morning, I need to format a few different cells in the following manners: A1 has to always add a colon (:) after whatever is typed in by a...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • Workbook_Change stopped working !
    I am working on an app to speed up & automate processing of Credit Cards statements. After data is input from a CSV file, it is presented to the...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
Top