Automating and looping a Web Query

abesimpson

Active Member
Joined
May 3, 2003
Messages
435
My spreadsheet is linked to a stock data web page using the little documented .iqy function. I have set cell A1 to the web page ticker symbol, so that whenever this cell value is changed the data in the spreadsheet is automatically updated.

My problem is in several parts:
1. Read TickerSymbol.csv file which is comprised of just ticker symbols,
2. Insert (TickerSymbol.csv) symbol 1 into cell A1,
3. Save the results to a file c:\XXX\Symbol1.csv,
4. Insert (TickerSymbol.csv) symbol 2,
5. repeat, repeat

Any and all help would be greatly appreciated.


abe
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
John w

I have my iqy file (I plan on collecting data from www.marketwatch.com), and the ticker list.

I hope/believe that given a working model I will be able to modify it to meet my needs. Could you post the code or the file?

Thanks in advance.

a
 
Upvote 0
Okay, here is the working example for Yahoo Finance. You should be able to adapt it easily for Marketwatch. Put all the code in a standard module.

As noted in the first comment, it is possible to use a URL connection string with parameters instead of the .iqy file, but this bit isn't working yet so I haven't included the code. See http://www.jkp-ads.com/Articles/WebQuery.asp

Also, if Create_Dynamic_Query_From_Iqy_File is called, Excel's 'Enter Parameter Value' dialogue appears. I have been attempting to set the parameter value programmatically so that the dialogue doesn't appear, but without success.

Code:
'Uses a dynamic web query, using either an .iqy file or a URL connection string, to retrieve stock data from
'Yahoo Finance (http://finance.yahoo.com).
'The stock quote symbols are read from a file containing one symbol per line.
'For each symbol, the stock data is retrieved using the dynamic web query and then saved in a file called <symbol>.csv.

'The dynamic web query is contained in the file YahooFinanceQuote.iqy, which contains:
'   WEB
'   1
'   http://finance.yahoo.com/q?s=["quote symbol","Enter cell containing quote symbol, e.g. =B1"]&=

 
Option Explicit
 
Const cQueryName = "YahooFinanceQuote"                  'Name of the dynamic web query
Const cSymbolsFile = "F:\Temp\Excel\TickerSymbols.csv"  'File containing symbols to be retrieved, one per line
Const cSaveToFolder = "F:\Temp\Excel\"                  'Folder in which to create the symbol.csv files

Const cIqyFile = "F:\Temp\Excel\YahooFinanceQuote.iqy"  'The .iqy file
Const cURL = "http://finance.yahoo.com/q?s="            'Yahoo Finance URL with the query field (s=) but not the field value

Const cParameterCell = "B1"                             'Cell containing the query field (s=) field value (Excel dynamic parameter)
Const cDataStartCell = "A2"                             'Cell where retrieved data begins
Const cDataEndCell = "B31"                              'Cell where retrieved data ends


Sub Retrieve_All_Symbols()

    Dim fileNum As Integer
    Dim symbol As String
    Dim queryName As String
    
    'Get web query (if it has been created manually) and create it if it doesn't exist
    
    queryName = Get_Web_Query_Name
    If queryName = "" Then
        'queryName = Create_Dynamic_Query_From_URL(cQueryName, cURL, cParameterCell, cDataStartCell)
        queryName = Create_Dynamic_Query_From_Iqy_File(cQueryName, cIqyFile, cParameterCell, cDataStartCell)
    End If
       
    fileNum = FreeFile
    Open cSymbolsFile For Input As #fileNum
    While Not EOF(fileNum)
        Line Input #fileNum, symbol
                
        'Put this quote symbol in the cell associated with the web query.  This causes the web query to automatically refresh
        'and retrieve the data for the symbol
        
        ActiveSheet.Range(cParameterCell).Value = symbol
        ActiveSheet.QueryTables(1).Refresh
                
        'Save the data returned
        
        Save_Stock_Data symbol, Range(cDataStartCell & ":" & cDataEndCell)
    Wend
    Close #fileNum
    
End Sub


Private Sub Save_Stock_Data(symbol As String, dataRange As Range)

    'Save the stock data for the symbol in the file <symbol>.csv
    
    Dim dataOutputFile As String
    Dim fileNum As Integer
    Dim csvLine As String
    Dim previousRow As Integer
    Dim cell As Range
    
    dataOutputFile = cSaveToFolder & symbol & ".csv"
    
    fileNum = FreeFile
    Open dataOutputFile For Output As #fileNum
    
    csvLine = ""
    previousRow = dataRange.row
    For Each cell In dataRange
        If cell.row = previousRow Then
            csvLine = csvLine & cell.Value & ","
        Else
            Print #fileNum, Left(csvLine, Len(csvLine) - 1)
            csvLine = cell.Value & ","
            previousRow = cell.row
        End If
    Next
        
    Close #fileNum
    
End Sub


Private Function Create_Dynamic_Query_From_URL(queryName As String, URL As String, parameterCell As String, _
        destinationCell As String) As String

    Dim qt As QueryTable
       
    'Code in this function was generated by the Macro Recorder as a result of
    'Data - Import External Data - Import Data - browse to .iqy file.
    'and then modified to include the quote symbol parameter in the connection string - see http://www.jkp-ads.com/Articles/WebQuery.asp
    'Therefore the .iqy file is not needed and the Parameter Value dialogue box doesn't appear when the querytable is added.
                
'   http://finance.yahoo.com/q?s=["quote symbol","Enter cell containing quote symbol, e.g. =B1"]&=
                
    Dim q As String
    q = "[""quote symbol"",""Enter cell containing quote symbol, e.g. =B1""]"
    Set qt = ActiveSheet.QueryTables.Add(Connection:="URL;" & cURL & q, Destination:=Range(destinationCell))
    
    With qt
        .Name = queryName
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = False    'False because data requests must be synchronous. Was True when generated by Macro Recorder
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = False
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = True
        With .Parameters(1)
            .SetParam xlRange, ActiveSheet.Range(parameterCell)
            .RefreshOnChange = True
        End With
        .Refresh BackgroundQuery:=False
    End With
    
    Create_Dynamic_Query_From_URL = qt.Name
    
End Function


Private Function Create_Dynamic_Query_From_Iqy_File(queryName As String, iqyFile As String, parameterCell As String, _
        destinationCell As String) As String

    Dim qt As QueryTable
    
    'Code in this function was generated by the Macro Recorder as a result of
    'Data - Import External Data - Import Data - browse to .iqy file
    'and then modified to suit this program
        
    Set qt = ActiveSheet.QueryTables.Add(Connection:="FINDER;" & iqyFile, Destination:=Range(destinationCell))
    
    With qt
        .Name = queryName
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = False    'False because data requests must be synchronous. Was True when generated by Macro Recorder
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = False
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = True       
        
        .Refresh BackgroundQuery:=False
    End With
    
    Create_Dynamic_Query_From_Iqy_File = qt.Name
    
End Function


Private Function Get_Web_Query_Name() As String
    
    Dim qt As QueryTable
    
    'Returns the name of the first web query on the active sheet, or "" if no queries exist
    
    If ActiveSheet.QueryTables.Count > 0 Then
        Get_Web_Query_Name = ActiveSheet.QueryTables(1).Name
    Else
        Get_Web_Query_Name = ""
    End If
    
End Function


'=========== Debugging and Information routines ===========

Private Sub Show_All_Queries()
    Dim qt As QueryTable
    For Each qt In ActiveSheet.QueryTables
        Debug.Print qt.Name
    Next
End Sub

Private Sub Delete_Query(queryName As String)
    Dim qt As QueryTable
    For Each qt In ActiveSheet.QueryTables
        If qt.Name = queryName Then qt.Delete
    Next
End Sub

Sub Delete_All_Queries()
    Dim qt As QueryTable
    For Each qt In ActiveSheet.QueryTables
        Debug.Print "Deleted " & qt.Name
        qt.Delete
    Next
End Sub
 
Upvote 0
I included the 'URL connection string with parameters' code after all and it does work! I had been playing around with it and the versions that didn't work only included the 'quote symbol' part from the .iqy file URL, not the full ["quote symbol","Enter cell containing quote symbol, e.g. =B1"]. Here is a tidied up version:

Code:
Private Function Create_Dynamic_Query_From_URL(queryName As String, URL As String, parameterCell As String, _
        destinationCell As String) As String

    Dim qt As QueryTable
    Dim URLquery As String
       
    'Code in this function was generated by the Macro Recorder as a result of
    'Data - Import External Data - Import Data - browse to .iqy file.
    'and then modified to include the quote symbol parameter in the connection string - see http://www.jkp-ads.com/Articles/WebQuery.asp
    'Therefore the .iqy file is not needed and the Parameter Value dialogue box doesn't appear when the querytable is added.
                
    'This is the URL from the .iqy file
    'http://finance.yahoo.com/q?s=["quote symbol","Enter cell containing quote symbol, e.g. =B1"]&=
                
    URLquery = "[""quote symbol"",""Enter cell containing quote symbol, e.g. =B1""]"
    
    Set qt = ActiveSheet.QueryTables.Add(Connection:="URL;" & URL & URLquery, Destination:=Range(destinationCell))
    
    With qt
        .Name = queryName
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = False    'False because data requests must be synchronous. Was True when generated by Macro Recorder
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = False
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = True
        With .Parameters(1)
            .SetParam xlRange, ActiveSheet.Range(parameterCell)
            .RefreshOnChange = True
        End With
        .Refresh BackgroundQuery:=False
    End With
    
    Create_Dynamic_Query_From_URL = qt.Name
    
End Function

Call it from Retrieve_All_Symbols() instead of the .iqy code like this:

Code:
    If queryName = "" Then
        queryName = Create_Dynamic_Query_From_URL(cQueryName, cURL, cParameterCell, cDataStartCell)
        'queryName = Create_Dynamic_Query_From_Iqy_File(cQueryName, cIqyFile, cParameterCell, cDataStartCell)
    End If
The result is that you don't need the .iqy file.
 
Upvote 0
WOW, words fail me... this is too cool. Given your code it raises a few questions re flexibility:

1- Would it be possible to have a file of web sites that is looped through in a similar manner as the ticker list so that from a single macro I can download data from Yahoo, Market Watch, etc., in turn? I am not looking to collect Stock Data (High, Low, etc) as much as analyst opinions which vary from site to site.

2- Is there any way to define a single table on a web page rather than the page itself (as would be the case with the .iqy file)?, then cycle to a next table on the same page and execute the import ticker loop cycle again? It would be easier to import result files into Access from single tables than from what might be multiple tables on different sites.

2a- If 2 is possible, then is the any way to make Const cDataEndCell = "B31" dynamic as the end value may vary?

Thanks for your help. This is without a doubt the cleanest, most structured, and best documented code I have ever seen.


abe
 
Upvote 0
I have run the import several times and realize that the tables do not appear to fully update when exporting. From ticker to ticker, some values are changed, some are not.

Timing issue?
 
Upvote 0
Thank you for your kind comments.

For the not updating when exporting problem, try changing RefreshStyle to:

.RefreshStyle = xlOverwriteCells 'Was xlInsertDeleteCells

For your other questions:

1. Yes, this is possible - anything is, really! The different URLs would have different query strings, so something which handled these would be needed. Generally it is easier to handle structured data like this when it is stored in an Excel sheet rather than a separate file.

2. Yes, the table number required is defined by the WebTables property of the QueryTable. Do a Web Query for the required table whilst the Macro Recorder is running and see what code it generates. Then plug that code into the Create_Dynamic_Query_From_URL subroutine.

2a. Yes, using this code:
Code:
        'Find the last row of data in column A
        
        Dim dataEndRow As Integer
        dataEndRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).row
                
        'Save the data returned
        
        Save_Stock_Data saveToFolder, symbol, Range(cDataStartCell & ":B" & dataEndRow)

There is also a bug in Save_Stock_Data which means it doesn't save the last row of data. To fix this, add this line immediately after the Next statement:
Code:
    Print #fileNum, Left(csvLine, Len(csvLine) - 1)
You don't have to use Web Queries for extracting this sort of data. Overall it might be better to use InternetExplorer automation or WinHttpRequest and HTML DOM parsing.
 
Upvote 0
John;

Nope still no significan difference between the saved files:

I believe I followed your instructions:

Code:
'Uses a dynamic web query, using either an .iqy file or a URL connection string, to retrieve stock data from
'Yahoo Finance (http://finance.yahoo.com).
'The stock quote symbols are read from a file containing one symbol per line.
'For each symbol, the stock data is retrieved using the dynamic web query and then saved in a file called TKR.csv.

'The dynamic web query is contained in the file YahooFinanceQuote.iqy, which contains:
'   WEB
'   1
'   http://finance.yahoo.com/q?s=["quote symbol","Enter cell containing quote symbol, e.g. =B1"]&=
 
Option Explicit
 
Const cQueryName = "YahooFinanceQuote"                  'Name of the dynamic web query
Const cSymbolsFile = "C:\Temp\Excel\TickerSymbols.csv"  'File containing symbols to be retrieved, one per line
Const cSaveToFolder = "C:\Temp\Excel\"                  'Folder in which to create the symbol.csv files

Const cIqyFile = "F:\Temp\Excel\YahooFinanceQuote.iqy"  'The .iqy file
Const cURL = "http://finance.yahoo.com/q?s="            'Yahoo Finance URL with the query field (s=) but not the field value

Const cParameterCell = "B1"                             'Cell containing the query field (s=) field value (Excel dynamic parameter)
Const cDataStartCell = "A2"                             'Cell where retrieved data begins
Const cDataEndCell = "B31"                              'Cell where retrieved data ends

Sub Retrieve_All_Symbols()

    Dim fileNum As Integer
    Dim symbol As String
    Dim queryName As String
    
    'Get web query (if it has been created manually) and create it if it doesn't exist
    
    queryName = Get_Web_Query_Name
 If queryName = "" Then
        queryName = Create_Dynamic_Query_From_URL(cQueryName, cURL, cParameterCell, cDataStartCell)
        'queryName = Create_Dynamic_Query_From_Iqy_File(cQueryName, cIqyFile, cParameterCell, cDataStartCell)
    End If
       
    fileNum = FreeFile
    Open cSymbolsFile For Input As #fileNum
    While Not EOF(fileNum)
        Line Input #fileNum, symbol
                
        'Put this quote symbol in the cell associated with the web query.  This causes the web query to automatically refresh
        'and retrieve the data for the symbol
        
        ActiveSheet.Range(cParameterCell).Value = symbol
        ActiveSheet.QueryTables(1).Refresh
                
        'Save the data returned
        
        Save_Stock_Data symbol, Range(cDataStartCell & ":" & cDataEndCell)
    Wend
    Close #fileNum
    
End Sub

Private Sub Save_Stock_Data(symbol As String, dataRange As Range)

    'Save the stock data for the symbol in the file .csv
    
    Dim dataOutputFile As String
    Dim fileNum As Integer
    Dim csvLine As String
    Dim previousRow As Integer
    Dim cell As Range
    
    dataOutputFile = cSaveToFolder & symbol & ".csv"
    
    fileNum = FreeFile
    Open dataOutputFile For Output As #fileNum
    
    csvLine = ""
    previousRow = dataRange.Row
    For Each cell In dataRange
        If cell.Row = previousRow Then
            csvLine = csvLine & cell.Value & ","
        Else
            Print #fileNum, Left(csvLine, Len(csvLine) - 1)
            csvLine = cell.Value & ","
            previousRow = cell.Row
        End If
    Next
    Print #fileNum, Left(csvLine, Len(csvLine) - 1)
    Close #fileNum
    
End Sub

Private Function Create_Dynamic_Query_From_URL(queryName As String, URL As String, parameterCell As String, _
        destinationCell As String) As String

    Dim qt As QueryTable
    Dim URLquery As String
       
    'Code in this function was generated by the Macro Recorder as a result of
    'Data - Import External Data - Import Data - browse to .iqy file.
    'and then modified to include the quote symbol parameter in the connection string - see http://www.jkp-ads.com/Articles/WebQuery.asp
    'Therefore the .iqy file is not needed and the Parameter Value dialogue box doesn't appear when the querytable is added.
                
    'This is the URL from the .iqy file
    'http://finance.yahoo.com/q?s=["quote symbol","Enter cell containing quote symbol, e.g. =B1"]&=
                
    URLquery = "[""quote symbol"",""Enter cell containing quote symbol, e.g. =B1""]"
    
    Set qt = ActiveSheet.QueryTables.Add(Connection:="URL;" & URL & URLquery, Destination:=Range(destinationCell))
    
    With qt
        .Name = queryName
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = False    'False because data requests must be synchronous. Was True when generated by Macro Recorder
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = False
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = True
        With .Parameters(1)
            .SetParam xlRange, ActiveSheet.Range(parameterCell)
            .RefreshOnChange = True
        End With
        .Refresh BackgroundQuery:=False
    End With
    
    Create_Dynamic_Query_From_URL = qt.Name
    
End Function

Private Function Create_Dynamic_Query_From_Iqy_File(queryName As String, iqyFile As String, parameterCell As String, _
        destinationCell As String) As String

    Dim qt As QueryTable
    
    'Code in this function was generated by the Macro Recorder as a result of
    'Data - Import External Data - Import Data - browse to .iqy file
    'and then modified to suit this program
        
    Set qt = ActiveSheet.QueryTables.Add(Connection:="FINDER;" & iqyFile, Destination:=Range(destinationCell))
    
    With qt
        .Name = queryName
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = False    'False because data requests must be synchronous. Was True when generated by Macro Recorder
        '.RefreshStyle = xlInsertDeleteCells
        .RefreshStyle = xlOverwriteCells 'Was xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = False
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = True
        
        .Refresh BackgroundQuery:=False
    End With
    
    Create_Dynamic_Query_From_Iqy_File = qt.Name
    
End Function

Private Function Get_Web_Query_Name() As String
    
    Dim qt As QueryTable
    
    'Returns the name of the first web query on the active sheet, or "" if no queries exist
    
    If ActiveSheet.QueryTables.Count > 0 Then
        Get_Web_Query_Name = ActiveSheet.QueryTables(1).Name
    Else
        Get_Web_Query_Name = ""
    End If
    
End Function

'=========== Debugging and Information routines ===========

Private Sub Show_All_Queries()
    Dim qt As QueryTable
    For Each qt In ActiveSheet.QueryTables
        Debug.Print qt.Name
    Next
End Sub

Private Sub Delete_Query(queryName As String)
    Dim qt As QueryTable
    For Each qt In ActiveSheet.QueryTables
        If qt.Name = queryName Then qt.Delete
    Next
End Sub

Sub Delete_All_Queries()
    Dim qt As QueryTable
    For Each qt In ActiveSheet.QueryTables
        Debug.Print "Deleted " & qt.Name
        qt.Delete
    Next
End Sub

Can you spot anything wrong?

Thanks

a
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,927
Members
448,533
Latest member
thietbibeboiwasaco

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