Hi Frank,
Here is the actual code as seen in the Microsoft Visual Basic window for the
GetStockValue sub/macro.
(The GetFund sub/macro follows it.)
I assume that they are subs that have to be invoked from the Tool/Macro
menu.
Both are working fine separately but it would easier if I could run them
sequentially either by putting them
in the same sub/macro or whatever it is called one after the other. Or, kept
them as they are now, ie. separate,
and invoke them sequentially from a controlling macro/sub or whatever it is.
GETSTOCKVALUES code as it appears in Microsoft Visual Basic window
----------------------------------------------------------------------------
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 (trailing 12 months)"
Private Const msDIVIDEND_RATE As String = "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
Private rng As Range
Private Start As Single, EndTime As Single, TimeTook As Single, TimeTaken As
Single, LT As Single
Private EPS As Single
Sub GetStockValues() ' I assume this indicates that it is a sub
ThisWorkbook.EnvelopeVisible = False
Start = Timer
Set rng = Range("b3:h17")
'ActiveWorkbook.Names.Add Name:="Output", RefersToR1C1:="=Sheet1!R1C1:R17C7"
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"
Range("B3:i17").ClearContents
' Application.ScreenUpdating = False
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
Cells(Rindex, 2) = GetValue(msLastTraded, s)
LT = GetValue(msROLLING_52_HIGH, s)
Cells(Rindex, 3) = Format(LT, "##.###")
Cells(Rindex, 4) = GetValue(msROLLING_52_LOW, s)
Cells(Rindex, 5) = GetValue(msPE_RATIO, s)
EPS = GetValue(msEPS, s)
Cells(Rindex, 6) = Format(EPS, "##.###")
Cells(Rindex, 7) = GetValue(msDIVIDEND_RATE, s)
Cells(Rindex, 8) = Format((Cells(Rindex, 7) / LT) * 100,
"##.###")
Cells(Rindex, 9) = Format((EPS / LT) * 100, "##.###")
'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
EndTime = Timer
TimeTook = (EndTime - Start) / 60
TimeTaken = Format(TimeTook, "##.##")
MsgBox (TimeTaken)
' Application.ScreenUpdating = True
' wbk1.Sheets(1).Calculate
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
GETSFUNDS code as it appears in Microsoft Visual Basic window
---------------------------------------------------------------------
Option Explicit
Sub getfunds()
'
' funds Macro
' Macro recorded 1/10/2004 by bob
'
'
Range("A1").Select
With Selection.QueryTable
.Connection = _
"URL;
http://www.tse.com/HttpController?SaveView=true&GetPage=StocklistViewPa
ge"
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "30"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub