Making output go to a worksheet
Bob,
This is the code I have tested at it works OK. I have tidied up the IE
application calls since you only need this once, dimensioned the variables
that where not explicitly stated (I use the Option Explicit to keep things
tight). Otherwise all was OK.
A few observations.
1. The range is not cleared before you attempt to load new data, this may or
may not be a problem. I thought one way round this would be to reset a flag
for each column at the start and then set it after each data are
successfully loaded, this way you keep the last data if there is nothing
found.
2. The procedure is quite long (time), you might think about putting in a
messages or a progress indicator
3. Some of the values are blank, not sure if this is a function error or the
website not holding these values, you'll need to check
4. You are still limited to 15 stock tickers (function of Rindex), but agian
this may not be a problem in this specific case
Good Luck!
Cheers
Nigel
Option Explicit
Private Const msLastTraded As String = "Last Traded"
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 msEPS As String = "Earnings/Share"
Private Const msDIVIDEND_RATE As String = "Indicated Dividend Rate"
Private Rindex As Byte, LastColumn As Byte, LastRow As Byte
Private sURL As String, sFirst As String, sSymbol As String, sLast, vs As
String
Private ie As Object, s As String, nStart As Integer, nEnd As Integer, wbk1
As Workbook
Private tx As String, cx As String
Sub GetStockValues()
ActiveWorkbook.Names.Add Name:="Output",
RefersToR1C1:="=Sheet1!R1C1:R17C8"
Set ie = CreateObject("InternetExplorer.Application")
sFirst =
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&DetailedView =Detail
edPrices&Language=en&QuoteSymbol_1="
sLast = "&x=18&y=7"
For Rindex = 3 To 17
' Construct an sURL to Navigate with
sURL = ""
sSymbol = Trim(Cells(Rindex, 1))
sURL = sFirst & sSymbol & sLast
ie.Navigate sURL
'wait for response
Do Until Not ie.Busy And ie.ReadyState = 4
DoEvents
Loop
' get html page body text
s = ie.Document.body.innertext
' get stock quote values using the function
Range("Output").Cells(Rindex, 3) = GetValue(msLastTraded, s)
Range("Output").Cells(Rindex, 4) = GetValue(msROLLING_52_HIGH,
s)
Range("Output").Cells(Rindex, 5) = GetValue(msROLLING_52_LOW, s)
Range("Output").Cells(Rindex, 6) = GetValue(msPE_RATIO, s)
Range("Output").Cells(Rindex, 7) = GetValue(msEPS, s)
Range("Output").Cells(Rindex, 8) = GetValue(msDIVIDEND_RATE, s)
Next Rindex
'close ie and remove memory references
ie.Quit
Set ie = Nothing
End Sub
Function GetValue(vs As String, s As String) As String
nStart = InStr(1, s, vs, vbTextCompare)
If nStart Then
nStart = nStart + Len(vs)
nEnd = InStr(nStart, s, vbCrLf)
End If
GetValue = Trim(Mid$(s, nStart, nEnd - nStart))
cx = ""
tx = ""
' retrieve only the number value
Dim i As Integer
For i = 1 To Len(GetValue)
tx = Mid$(GetValue, i, 1)
If InStr(1, "1234567890.", tx) Then
cx = cx & tx
Else
Exit For
End If
Next i
GetValue = cx
End Function
' eof bob benjamin stock extract routine ****************
"Bob Benjamin" wrote in message
...
Thanks, Nigel, for the message.
You're rght the comma is missing but I still still get the error message.
Run-time error '1004'
Method Range of object _ Global failed.
After the sub-routine failed, I printed in the Immediate Window the
parameters passed\0
to the GetValue function and the value returned. They were fine.
I then changed the Range statement to:
Range("Output").Cells(4, 4) = "hhh" to see if that
would put a value "hhh" in sheet1, it didn't.
It also produces the error message Run-time error '1004', Method Range of
object _ Global failed.
From that test, I figure that the stuff on the left-hand side of the equal
sign
(i.e., Range("Output").Cells(4, 4)) is causing of the problem.
My guess now is that maybe the statement
ActiveWorkbook.Names.Add Name:="Output",
RefersToR1C1:="=Sheet1!R1C1:R17C8"
statement
is connected to the problem..
Maybe it is in the wrong spot? or
Maybe the R1C1-type of referencing has to be converted to A1-type
referencing? or maybe
Output has to be defined as a global. variable or the Range line it is not
compatible with the lines before it or something
I don't know what else to do.
As far as I can see the sub-routine is fine except the routine will not
put
the values in sheet1.
Maybe I need to use the actual reference instead of Sheet1!R1C1:R17C8
i.e.,
use "sheet!TSER1C1:R17C8"? instead or something like that.
Any ideas?
Below is the my current listng:
Private Const msLastTraded As String = "Last Traded"
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 msEPS As String = "Earnings/Share"
Private Const msDIVIDEND_RATE As String = "Indicated Dividend Rate"
Private Rindex As Byte, LastColumn As Byte, LastRow As Byte
Private sURL As String, sFirst As String, sSymbol As String, sLast, vs
As String
Function GetValue(vs As String, s As String) As String
nStart = InStr(1, s, vs, vbTextCompare)
If nStart Then
nStart = nStart + Len(vs)
nEnd = InStr(nStart, s, vbCrLf)
End If
GetValue = Trim(Mid$(s, nStart, nEnd - nStart))
c$ = ""
t$ = ""
' retrieve only the number value
For i = 1 To Len(GetValue)
t$ = Mid$(GetValue, i, 1)
If InStr(1, "123567890.", t$) Then
c$ = c$ & t$
Else
Exit For
End If
Next i
GetValue = c$
End Function
Sub GetStockValues()
Dim ie As Object
Dim s As String
Dim nStart As Integer
Dim nEnd As Integer
ActiveWorkbook.Names.Add Name:="Output",
RefersToR1C1:="=Sheet1!R1C1:R17C8"
' How many stock quotes are there?
Set wbk1 = ThisWorkbook
With wbk1.Sheets(1)
' LastColumn = .Cells(1, 2).End(xlToRight).Column
LastRow = .Cells(2, 1).End(xlDown).Row
End With
For Rindex = 3 To LastRow
Set ie = CreateObject("InternetExplorer.Application")
' Construct an sURL to Navigate with
sFirst =
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&DetailedView =Detail
edPrices&Language=en&QuoteSymbol_1="
sLast = "&x=18&y=7"
sURL = ""
sSymbol = Trim(Cells(Rindex, 1))
sURL = sFirst & sSymbol & sLast
With ie
'.Navigate
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&DetailedView =Detail
edPrices&Language=en&QuoteSymbol_1=BCE&x=18&y=7"
.Navigate sURL
Do Until Not .Busy And .ReadyState = 4
DoEvents
Loop
s = ie.Document.body.innertext
.Quit
End With
' Set ie = Nothing ' I'm not sure
if
this is needed so I commented it out.
' get stock quote values using the function
' Range("Output").Cells(Rindex, 3) = GetValue(msLastTraded, s)
' Range("Output").Cells(4, 4) = GetValue(msROLLING_52_HIGH, s)
Range("Output").Cells(4, 4) = "hhh"
' Range("Output").Cells(Rindex, 5) = GetValue(msROLLING_52_LOW, s)
' Range("Output").Cells(rindex, 6) = GetValue(msPE_RATIO, s)
' Range("Output").Cells(rindex, 7) = GetValue(msEPS, s)
' Range("Output").Cells(rindex, 8) = GetValue(msDIVIDEND_RATE, s)
Next Rindex
End Sub
"Nigel" wrote in message
...
Bob
Is it a simple case of a mssing comma in the cells index settings?
eg
Range("Output").Cells(Rindex 3) = GetValue(msROLLING_52_HIGH, s)
should read
Range("Output").Cells(Rindex, 3) = GetValue(msROLLING_52_HIGH, s)
Cheers
Nigel
"Bob Benjamin" wrote in message
...
I need some more help with the Range statements.
I am trying to write a VBA sub-routine to fill in spreadsheet
(sheet1),
range R3C2:R17C7 with stock information.
This is what sheet (1) looks like:
I want to fill in R3C2 to R17C7 with stock quote values
A B C D E
F G
Last Trade
Hi
Lo
PE
EPS
DIV
Search Key
Last Traded
Week High
Week Low
P/E Ratio
Earnings/Share
dividend rate
ATY
BBD.B
BCE
BMO
GND
NT
T
T.A
TA
ZEN
POW
TOC
ROC
FFH
DBC.A
I have added a function to eliminate some of the repetitive code.
But line: Range("Output").Cells(4, 4) =
GetValue(msROLLING_52_HIGH,
s)
keeps causing the following error message:
Run-time error '1004'
Method Range of object _ Global failed
Below is my listing:
Private Const msROLLING_52_HIGH As String = "Rolling 52 Week High"
Private Rindex As Byte, LastRow As Byte
Private sURL As String, sFirst As String, sSymbol As String,
sLast,
vs
As String
Function GetValue(vs As String, s As String) As String
nStart = InStr(1, s, vs, vbTextCompare)
If nStart Then
nStart = nStart + Len(vs)
nEnd = InStr(nStart, s, vbCrLf)
End If
GetValue = Trim(Mid$(s, nStart, nEnd - nStart))
c$ = ""
t$ = ""
' retrieve only the number value
For i = 1 To Len(GetValue)
t$ = Mid$(GetValue, i, 1)
If InStr(1, "123567890.", t$) Then
c$ = c$ & t$
Else
Exit For
End If
Next i
GetValue = c$
End Function
Sub GetStockValues()
Dim ie As Object
Dim s As String
Dim nStart As Integer
Dim nEnd As Integer
ActiveWorkbook.Names.Add Name:="Output",
RefersToR1C1:="=Sheet1!R1C1:R17C8"
' How many stock quotes are there?
Set wbk1 = ThisWorkbook
With wbk1.Sheets(1)
' LastColumn = .Cells(1, 2).End(xlToRight).Column
LastRow = .Cells(2, 1).End(xlDown).Row
End With
'Get values for every quote using row index (rindex)
For Rindex = 3 To LastRow
Set ie = CreateObject("InternetExplorer.Application")
' Construct an sURL to Navigate with
sFirst =
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&DetailedView =Detail
edPrices&Language=en&QuoteSymbol_1="
sLast = "&x=18&y=7"
sURL = ""
sSymbol = Trim(Cells(Rindex, 1))
sURL = sFirst & sSymbol & sLast
With ie
'.Navigate
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&DetailedView =Detail
edPrices&Language=en&QuoteSymbol_1=BCE&x=18&y=7"
.Navigate sURL
Do Until Not .Busy And .ReadyState = 4
DoEvents
Loop
s = ie.Document.body.innertext
.Quit
End With
' Set ie = Nothing
' get stock quote values using the function
Range("Output").Cells(Rindex 3) = GetValue(msROLLING_52_HIGH, s)
Next Rindex
End Sub
Any help woud be appreciated.
BobB
"Nigel" wrote in message
...
Hi Bob,
I re-tested my version and I do not get the error!! What version of
Excel
are you using?
Here is the listing I used......
Option Explicit
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
ActiveWorkbook.Names.Add Name:="Output",
RefersToR1C1:="=Sheet1!R1C1:R4C1"
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Navigate
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&DetailedView =Detail
edPrices&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)
Range("Output").Cells(1, 1) = 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)
Range("Output").Cells(2, 1) = 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)
Range("Output").Cells(3, 1) = 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)
Range("Output").Cells(4, 1) = msDIVIDEND_RATE & ": " &
Mid$(s,
nStart, _
nEnd - nStart)
End If
End Sub
"Bob Benjamin" wrote in message
...
Hi,
I tried the suggested approach but I get the error message"
"Run-time error '1004'
"Method 'Range of object'_Global failed'"
Is it a syntact error?
The error is for line:
Range("Output").Cells(1, 1).Value = msROLLING_52_HIGH &
":"
&
Mid$(s, nStart, nEnd - nStart)
Note I added ".Value" after I first got the error and s to Cell.
Below is the entire code for the sub-routine:
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")
Set wbk1 = ActiveWorkbook
ActiveWorkbook.Names.Add Name:="Output",
RefersToR1C1:="=Sheet1!R1C1:R50C1"
With ie
.Navigate
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&" _
&
"DetailedView=DetailedPrices&Language=en&QuoteSymb ol_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)
' Range("Output").Cell(1, 1) = msROLLING_52_HIGH & ":" & Mid$(s,
nStart,
nEnd - nStart)
Range("Output").Cells(1, 1).Value = msROLLING_52_HIGH & ":" &
Mid$(s,
nStart, nEnd - nStart)
' Range("Output").Cells(1, 1).Value = 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
"Nigel" wrote in message
...
Replace all the debug print with sheet reference.
Since you are building a text string for each output line, that
string
could
be entered directly into the sheet with
'Set up a named range Output (not essential but I prefer this
approach)
ActiveWorkbook.Names.Add Name:="Output",
RefersToR1C1:="=Sheet1!R1C1:R20C1"
' store string into the cell row 1 of the output range
Range("Output").Cell.(1,1) = msROLLING_52_HIGH & ": " & Mid$(s,
nStart,
nEnd - nStart)
Using this method you can programmatically control the location
using
the
Cell row and column index values and index through all the
values.
You
might consider wrting each stock value in one row, in which case
make
the
range multiple columns and change the column index for each
stock
value,
before changing the row index to move onto the next stock.
Cheers
N
"Bob Benjamin" wrote in message
...
How can I modify the following code to direct its output
to a worksheet instead of to the immediate window?
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&QuoteSymbo l_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
----== Posted via Newsfeed.Com - Unlimited-Uncensored-Secure
Usenet
News==----
http://www.newsfeed.com The #1 Newsgroup Service in the World!
100,000
Newsgroups
---= 19 East/West-Coast Specialized Servers - Total Privacy via
Encryption
=---
----== Posted via Newsfeed.Com - Unlimited-Uncensored-Secure Usenet
News==----
http://www.newsfeed.com The #1 Newsgroup Service in the World!
100,000
Newsgroups
---= 19 East/West-Coast Specialized Servers - Total Privacy via
Encryption
=---
----== Posted via Newsfeed.Com - Unlimited-Uncensored-Secure Usenet
News==----
http://www.newsfeed.com The #1 Newsgroup Service in the World! 100,000
Newsgroups
---= 19 East/West-Coast Specialized Servers - Total Privacy via
Encryption
=---
"Nigel" wrote in message
...
Bob
Is it a simple case of a mssing comma in the cells index settings?
eg
Range("Output").Cells(Rindex 3) = GetValue(msROLLING_52_HIGH, s)
should read
Range("Output").Cells(Rindex, 3) = GetValue(msROLLING_52_HIGH, s)
Cheers
Nigel
"Bob Benjamin" wrote in message
...
I need some more help with the Range statements.
I am trying to write a VBA sub-routine to fill in spreadsheet
(sheet1),
range R3C2:R17C7 with stock information.
This is what sheet (1) looks like:
I want to fill in R3C2 to R17C7 with stock quote values
A B C D E
F G
Last Trade
Hi
Lo
PE
EPS
DIV
Search Key
Last Traded
Week High
Week Low
P/E Ratio
Earnings/Share
dividend rate
ATY
BBD.B
BCE
BMO
GND
NT
T
T.A
TA
ZEN
POW
TOC
ROC
FFH
DBC.A
I have added a function to eliminate some of the repetitive code.
But line: Range("Output").Cells(4, 4) =
GetValue(msROLLING_52_HIGH,
s)
keeps causing the following error message:
Run-time error '1004'
Method Range of object _ Global failed
Below is my listing:
Private Const msROLLING_52_HIGH As String = "Rolling 52 Week High"
Private Rindex As Byte, LastRow As Byte
Private sURL As String, sFirst As String, sSymbol As String,
sLast,
vs
As String
Function GetValue(vs As String, s As String) As String
nStart = InStr(1, s, vs, vbTextCompare)
If nStart Then
nStart = nStart + Len(vs)
nEnd = InStr(nStart, s, vbCrLf)
End If
GetValue = Trim(Mid$(s, nStart, nEnd - nStart))
c$ = ""
t$ = ""
' retrieve only the number value
For i = 1 To Len(GetValue)
t$ = Mid$(GetValue, i, 1)
If InStr(1, "123567890.", t$) Then
c$ = c$ & t$
Else
Exit For
End If
Next i
GetValue = c$
End Function
Sub GetStockValues()
Dim ie As Object
Dim s As String
Dim nStart As Integer
Dim nEnd As Integer
ActiveWorkbook.Names.Add Name:="Output",
RefersToR1C1:="=Sheet1!R1C1:R17C8"
' How many stock quotes are there?
Set wbk1 = ThisWorkbook
With wbk1.Sheets(1)
' LastColumn = .Cells(1, 2).End(xlToRight).Column
LastRow = .Cells(2, 1).End(xlDown).Row
End With
'Get values for every quote using row index (rindex)
For Rindex = 3 To LastRow
Set ie = CreateObject("InternetExplorer.Application")
' Construct an sURL to Navigate with
sFirst =
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&DetailedView =Detail
edPrices&Language=en&QuoteSymbol_1="
sLast = "&x=18&y=7"
sURL = ""
sSymbol = Trim(Cells(Rindex, 1))
sURL = sFirst & sSymbol & sLast
With ie
'.Navigate
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&DetailedView =Detail
edPrices&Language=en&QuoteSymbol_1=BCE&x=18&y=7"
.Navigate sURL
Do Until Not .Busy And .ReadyState = 4
DoEvents
Loop
s = ie.Document.body.innertext
.Quit
End With
' Set ie = Nothing
' get stock quote values using the function
Range("Output").Cells(Rindex 3) = GetValue(msROLLING_52_HIGH, s)
Next Rindex
End Sub
Any help woud be appreciated.
BobB
"Nigel" wrote in message
...
Hi Bob,
I re-tested my version and I do not get the error!! What version of
Excel
are you using?
Here is the listing I used......
Option Explicit
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
ActiveWorkbook.Names.Add Name:="Output",
RefersToR1C1:="=Sheet1!R1C1:R4C1"
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Navigate
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&DetailedView =Detail
edPrices&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)
Range("Output").Cells(1, 1) = 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)
Range("Output").Cells(2, 1) = 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)
Range("Output").Cells(3, 1) = 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)
Range("Output").Cells(4, 1) = msDIVIDEND_RATE & ": " &
Mid$(s,
nStart, _
nEnd - nStart)
End If
End Sub
"Bob Benjamin" wrote in message
...
Hi,
I tried the suggested approach but I get the error message"
"Run-time error '1004'
"Method 'Range of object'_Global failed'"
Is it a syntact error?
The error is for line:
Range("Output").Cells(1, 1).Value = msROLLING_52_HIGH &
":"
&
Mid$(s, nStart, nEnd - nStart)
Note I added ".Value" after I first got the error and s to Cell.
Below is the entire code for the sub-routine:
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")
Set wbk1 = ActiveWorkbook
ActiveWorkbook.Names.Add Name:="Output",
RefersToR1C1:="=Sheet1!R1C1:R50C1"
With ie
.Navigate
"http://www.tse.ca/HttpController?GetPage=QuotesViewPage&" _
&
"DetailedView=DetailedPrices&Language=en&QuoteSymb ol_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)
' Range("Output").Cell(1, 1) = msROLLING_52_HIGH & ":" & Mid$(s,
nStart,
nEnd - nStart)
Range("Output").Cells(1, 1).Value = msROLLING_52_HIGH & ":" &
Mid$(s,
nStart, nEnd - nStart)
' Range("Output").Cells(1, 1).Value = 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
"Nigel" wrote in message
...
Replace all the debug print with sheet reference.
Since you are building a text string for each output line, that
string
could
be entered directly into the sheet with
'Set up a named range Output (not essential but I prefer this
approach)
ActiveWorkbook.Names.Add Name:="Output",
RefersToR1C1:="=Sheet1!R1C1:R20C1"
' store string into the cell row 1 of the output range
Range("Output").Cell.(1,1) = msROLLING_52_HIGH & ": " & Mid$(s,
nStart,
nEnd - nStart)
Using this method you can programmatically control the location
using
the
Cell row and column index values and index through all the
values.
You
might consider wrting each stock value in one row, in which case
make
the
range multiple columns and change the column index for each
stock
value,
before changing the row index to move onto the next stock.
Cheers
N
"Bob Benjamin" wrote in message
...
How can I modify the following code to direct its output
to a worksheet instead of to the immediate window?
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&QuoteSymbo l_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
----== Posted via Newsfeed.Com - Unlimited-Uncensored-Secure
Usenet
News==----
http://www.newsfeed.com The #1 Newsgroup Service in the World!
100,000
Newsgroups
---= 19 East/West-Coast Specialized Servers - Total Privacy via
Encryption
=---
----== Posted via Newsfeed.Com - Unlimited-Uncensored-Secure Usenet
News==----
http://www.newsfeed.com The #1 Newsgroup Service in the World!
100,000
Newsgroups
---= 19 East/West-Coast Specialized Servers - Total Privacy via
Encryption
=---
----== Posted via Newsfeed.Com - Unlimited-Uncensored-Secure Usenet
News==----
http://www.newsfeed.com The #1 Newsgroup Service in the World! 100,000
Newsgroups
---= 19 East/West-Coast Specialized Servers - Total Privacy via
Encryption
=---
----== Posted via Newsfeed.Com - Unlimited-Uncensored-Secure Usenet News==----
http://www.newsfeed.com The #1 Newsgroup Service in the World! 100,000 Newsgroups
---= 19 East/West-Coast Specialized Servers - Total Privacy via Encryption =---
|