Is there a way to get a portion of a WEB

  • Thread starter Thread starter Bob Benjamin
  • Start date Start date
B

Bob Benjamin

From your help I am now able to write in Excel VBA a SUB to get a WEB page
and search it for specific text.

Is it possible to go to a WEB site and pull off just a section of the page
instead of the entire page?

For example, if you go to the following TSE web site:

http://www.tse.ca/HttpController?Ge...dPrices&Language=en&QuoteSymbol_1=bce&x=3&y=6

Is it possible to retrieve the two tables called LAST TRADE and END OF DAY
DATA?
What would the VBA SUB look like?
Would Excel VBA retrieve the tables faster than the entire page?

As always, I look forward to your response.

Regards,
Bob
 
Is it possible to go to a WEB site and pull off just a section of the page
instead of the entire page?<

No way that I'm aware of (and there's lots I'm unaware of!), unless there is
a specific url reference for that piece of the page within the source code.
For example, images are stored separately and loaded dynamically when you
open a webpage (my primitive understanding). If you look at the source code
for the page (right click the page and choose "view source") or if you open
the page and make it into an object with VB and look at the object's
properties (using the "locals" window), you will see the url for the image.
If you go to that url you will get the image displayed in the browser and
nothing else.

I have never seen tables with their own URL--they are (again, my primitive
understanding) created dynamically (i.e., according to input that you key
into a web page) from a database and designed to display within a particular
format on a web page.

The way I used to deal with tables, is to remove the formatting, define the
range they will appear on the worksheet (i.e., search for key cells for the
beginning of the range and for the end of the range), and save the table as
a workbook. Nowadays I extract the data I want and put it in a database.
But in some cases I download the entire webpage first, and do the data
extraction later.

HTH,
Shockley
 
Manually, you can do a New Web Query from Excel to get a portion of a Web
page
and you can record the Macro in VBA but the code does not work.
Try this to see what I mean:

From the Excel standard menu: (i.e., not with VBA)

1. Create a blank Excel work sheet
2. then select from the Data menu

Import External Data
New Web Query

3. In address box: enter www.tse.ca
4. Press Go

5 When www.tse.ca page appears
enter the stock symbol BCE in the "Equity Search" box & then press the
Get Quote button

6 When that web screen appears
scroll down to the END OF DAY DATA.

Notice all the Yellow arrows.

7 Check the Yellow arrow next to the END OF DAY DATA table so that it
changes into a Green check mark

8 Press the Import button

Notice that only part of the web page, the END OF DAY DATA table is
retrieved.

If you turn the Macro recorder on when you do these steps the following VBA
code is generated:

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 16/11/2003 by Bob

With Selection.querytable
.Connection = _

"URL;http://www.tse.ca/HttpController?GetPage=QuotesViewPage&DetailedView=De
tailedPrices&Language=en&QuoteSymbol_1=bce&x=23&y=4"
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "26,28" '
this is probably the table END OF DAY DATA
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End SubBob

When I run the macro above I get the following error message:

Run-time error '1004'
Application-defined or object-defined error.

Regards,
Bob
 
I tried again to record the macro and it now runs without the error message.
I am not sure

what I did differently.

Here's the revised Macro:

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 17/11/2003 by Bob
'
With ActiveSheet.QueryTables.Add(Connection:= _

"URL;http://www.tse.ca/HttpController?GetPage=QuotesViewPage&DetailedView=De
tailedPrices&Language=en&QuoteSymbol_1=bce&x=18&y=7" _
, Destination:=Range("A1"))
.Name = _

"HttpController?GetPage=QuotesViewPage&DetailedView=DetailedPrices&Language=
en&QuoteSymbol_1=bce&x=18&y=7"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "28"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub

Is there a way to modify the following SUB to just parse the LAST TRADE and
END OF DAY DATA tables for the

Last Traded Rolling 52Week High Rolling Week Low P/E Ratio
Earnings/Share Indicated dividend rate

values?

Sub tse()
Application.ScreenUpdating = False
Start = Timer
' Dim rng As Range
' Set rng = Range("B3:H12")
' rng.Delete

Set wbk1 = ThisWorkbook
Worksheets(1).EnableCalculation = False
With wbk1.Sheets(1)
LastColumn = .Cells(1, 2).End(xlToRight).Column
LastRow = .Cells(2, 1).End(xlDown).Row
End With

For i = 3 To LastRow
sURL = ""
Symbol = Cells(i, 1)
' sURL = "http://finance.yahoo.com/q?s=" & Symbol
sURL =
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&DetailedView=Detail
edPrices&Language=en&QuoteSymbol_1="
sURL = sURL & Symbol & "&x=11&y=8"
Workbooks.Open sURL

Set wbk2 = ActiveWorkbook

With wbk2.Sheets(1)
.Columns("A:R").EntireColumn.Delete
.Rows("1:56").EntireRow.Delete
.Cells.ClearFormats
.Cells(1, 1).Select
.Columns.ColumnWidth = 10
.Rows.RowHeight = 12
End With

' Columns("A:R").Select
' Selection.Delete Shift:=xlToLeft
' Rows(1:59).Select
' Selection.Delete Shift:=xlUp

For j = 2 To LastColumn
SEARCHKEY = wbk1.Sheets(1).Cells(2, j)
Cells.Find (SEARCHKEY)

wbk1.Sheets(1).Cells(i, j) _
= wbk2.Sheets(1).Cells.Find _
(SEARCHKEY).Offset(0, 1)
Next j
wbk2.Close SaveChanges:=False
Next i
endtime = Timer
MsgBox (endtime - Start) / 60
Application.ScreenUpdating = False
End Sub


We're getting there. Thanks for the help.

Regards, Bob
 
Bob,

I can't run your query code on my computer because my Excel version is older
and doesn't have all the QueryTable properties that yours does. But I did
modify your recorded macro to show how you can substitute different symbols
and put the operation in a loop if you want. My code is untested so there
may be some minor errors.

I'll take a look at your second question later on when I get a moment.

Regards,
Shockley


Sub Macro3()
Dim qt As QueryTable
Base01 = "URL;http://www.tse.ca/"
Base02 =
"HttpController?GetPage=QuotesViewPage&DetailedView=DetailedPrices&Language=
en&QuoteSymbol_1="
Base03 = "&x=18&y=7"
Symbol = "bce"
sConnection = Base01 & Base02 & Symbol
sName = Base02 & Symbol & Base03
Set qt = ActiveSheet.QueryTables.Add( _
Connection:=sConnection, _
Destination:=Range("A1"))
With qt
.Name = sName
.FieldNames = True
.PreserveFormatting = True
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "28"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
End With
End Sub
 
Bob,

What I would do is have two worksheets. On the first one, call it "ref", put
your list of symbols in one column and your list of searchkeys in another.
In the macro define two LastRow variables, say, LastSymbolRow and LastKeyRow
and set each one using the method LastxxxRow = Cells(65536, y).End(xlUp)
where y is the column number for that list. When recording the data you
could put the symbols across the first row as you get the data for each one
and, only on the first time through, record the list of data types (search
keys) in the first column. This is basic vba logistics that I think you can
handle but let me know if you have problems.

Regards,
Shockley
 
Bob,

Bob said:
Is there a way to modify the following SUB to just parse the LAST
TRADE and END OF DAY DATA tables for the

Last Traded Rolling 52Week High Rolling Week Low P/E Ratio
Earnings/Share Indicated dividend rate values?
Click to expand...

A cleaner alternative IMO is to automate IE to navigate to the page and grab
the necessary values. Here's some code that should do what you want:

Private Const msROLLING_52_HIGH As String = "Rolling 52 Week High"
Private Const msROLLING_52_LOW As String = "Rolling 52 Week Low"
Private Const msPE_RATIO As String = "P/E Ratio"
Private Const msDIVIDEND_RATE As String = "Indicated Dividend Rate"

Sub GetStockValues()
Dim ie As Object
Dim s As String
Dim nStart As Integer
Dim nEnd As Integer

Set ie = CreateObject("InternetExplorer.Application")

With ie
.Navigate
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&D" _
&
"etailedView=DetailedPrices&Language=en&QuoteSymbol_1=bce&x=18&y=7"
Do Until Not .Busy And .ReadyState = 4
DoEvents
Loop

s = ie.Document.body.innertext
.Quit
End With
Set ie = Nothing

'/ get rolling 52-wk high
nStart = InStr(1, s, msROLLING_52_HIGH, vbTextCompare)
If nStart Then
nStart = nStart + Len(msROLLING_52_HIGH)
nEnd = InStr(nStart, s, vbCrLf)
Debug.Print msROLLING_52_HIGH & ": " & Mid$(s, nStart, _
nEnd - nStart)
End If

'/ get rolling 52-wk low
nStart = InStr(1, s, msROLLING_52_LOW, vbTextCompare)
If nStart Then
nStart = nStart + Len(msROLLING_52_LOW)
nEnd = InStr(nStart, s, vbCrLf)
Debug.Print msROLLING_52_LOW & ": " & Mid$(s, nStart, _
nEnd - nStart)
End If

'/ get p/e ratio
nStart = InStr(1, s, msPE_RATIO, vbTextCompare)
If nStart Then
nStart = nStart + Len(msPE_RATIO)
nEnd = InStr(nStart, s, vbCrLf)
Debug.Print msPE_RATIO & ": " & Mid$(s, nStart, _
nEnd - nStart)
End If

'/ get dividend rate
nStart = InStr(1, s, msDIVIDEND_RATE, vbTextCompare)
If nStart Then
nStart = nStart + Len(msDIVIDEND_RATE)
nEnd = InStr(nStart, s, vbCrLf)
Debug.Print msDIVIDEND_RATE & ": " & Mid$(s, nStart, _
nEnd - nStart)
End If
End Sub

--
Regards,

Jake Marx
MS MVP - Excel
www.longhead.com

[please keep replies in the newsgroup - email address unmonitored]
 
Back
Top