Info

Private Sub GetQuote()

Dim ie As Object, lCharPos As Long, sHTML As String Dim HistDate As Date, HighVal As String, LowVal As String Dim cl As Range

If Intersect(cl, [c2:c65366]) Is Nothing Then MsgBox "You must select a cell in column C." Exit Sub End If

If Not CBool(Len(cl(, -1))) Or Not CBool(Len(cl(, 0))) Then MsgBox "You must enter a symbol and date." Exit Sub End If

Set ie = CreateObject("InternetExplorer.Application")

With ie

.Navigate _

http://bigcharts.marketwatch.com/historical & _ "/default.asp?detect=1&symbol=" _

& cl(, -1) & "&close_date=" & Month(HistDate) & "%2F" & Day(HistDate) & "%2F" & Year(HistDate) & "&x=31&y=26" Do While .Busy And .ReadyState <> 4 DoEvents

Loop sHTML = .Document.body.innertext .Quit End With

Set ie = Nothing lCharPos = InStr(1, sHTML, "High:", vbTextCompare) If lCharPos Then HighVal = Mid$(sHTML, lCharPos + 5, 15)

If Not Left$(HighVal, 3) = "n/a" Then lCharPos = InStr(1, sHTML, "Low:", vbTextCompare) If lCharPos Then LowVal = Mid$(sHTML, lCharPos + 4, 15) cl.Value = (Val(LowVal) + Val(HighVal)) / 2 Else: lCharPos = InStr(1, sHTML, "Closing Price:", vbTextCompare)

cl.Value = Val(Mid$(sHTML, lCharPos + 14, 15)) End If

Set cl = Nothing End Sub

0 0

Post a comment