Him
I'm trying to create a worksheet that updates when I want different criteria from a stock listed in column A such as the Realtime price and EPS. I have code that seems to work to pull the name of the stock, but nothing that can pull in the Realtime Price. I've used similar code to the one for getting the fund name, but nothing seems to work. Any help. Here's the code I use.
Option Explicit
Sub WebPull()
Dim oHttp As Object
Dim sSymbolColumn As String, WorksheetName As String, sSymbol As String, sURL As String, sHTML As String
Dim sData As String, sRating As String
Dim iSymbolRow As Integer, iRow As Integer
Dim lClose As Long, lStart As Long, lEnd As Long, lMoreClose As Long, lRatingEnd As Long
Dim iTableColumn As Integer, i As Integer, iTableRow As Integer
Dim firstTime As Long
Set oHttp = CreateObject("MSXML2.XMLHTTP")
sSymbolColumn = "A"
WorksheetName = "WebPull"
iSymbolRow = 3
sSymbol = Worksheets(WorksheetName).Range(sSymbolColumn & iSymbolRow).Value
iRow = 0
iTableColumn = 0
For iTableRow = 0 To Worksheets(WorksheetName).Range("A1").CurrentRegion.Rows.Count - 3
'sSymbol=Trim(sSymbol)
sURL = "http://www.google.com/finance?q=" & sSymbol
oHttp.Open "GET", sURL, False
oHttp.send
sHTML = oHttp.responsetext
'--------------
'GET FUND NAME
'--------------
lStart = InStr(1, sHTML, "<h3>", vbTextCompare)
lEnd = InStr(lStart, sHTML, "</h3>", vbTextCompare)
'get it
sData = Trim(Mid(sHTML, lStart, lEnd - lStart))
TrimExtraSpacesExcluding sData
sData = Trim(sData)
'store it
Worksheets(WorksheetName).Range(sSymbolColumn & iSymbolRow).Offset(iRow, iTableColumn + 1).Value = sData
Next iTableRow
End Sub
I'm trying to create a worksheet that updates when I want different criteria from a stock listed in column A such as the Realtime price and EPS. I have code that seems to work to pull the name of the stock, but nothing that can pull in the Realtime Price. I've used similar code to the one for getting the fund name, but nothing seems to work. Any help. Here's the code I use.
Option Explicit
Sub WebPull()
Dim oHttp As Object
Dim sSymbolColumn As String, WorksheetName As String, sSymbol As String, sURL As String, sHTML As String
Dim sData As String, sRating As String
Dim iSymbolRow As Integer, iRow As Integer
Dim lClose As Long, lStart As Long, lEnd As Long, lMoreClose As Long, lRatingEnd As Long
Dim iTableColumn As Integer, i As Integer, iTableRow As Integer
Dim firstTime As Long
Set oHttp = CreateObject("MSXML2.XMLHTTP")
sSymbolColumn = "A"
WorksheetName = "WebPull"
iSymbolRow = 3
sSymbol = Worksheets(WorksheetName).Range(sSymbolColumn & iSymbolRow).Value
iRow = 0
iTableColumn = 0
For iTableRow = 0 To Worksheets(WorksheetName).Range("A1").CurrentRegion.Rows.Count - 3
'sSymbol=Trim(sSymbol)
sURL = "http://www.google.com/finance?q=" & sSymbol
oHttp.Open "GET", sURL, False
oHttp.send
sHTML = oHttp.responsetext
'--------------
'GET FUND NAME
'--------------
lStart = InStr(1, sHTML, "<h3>", vbTextCompare)
lEnd = InStr(lStart, sHTML, "</h3>", vbTextCompare)
'get it
sData = Trim(Mid(sHTML, lStart, lEnd - lStart))
TrimExtraSpacesExcluding sData
sData = Trim(sData)
'store it
Worksheets(WorksheetName).Range(sSymbolColumn & iSymbolRow).Offset(iRow, iTableColumn + 1).Value = sData
Next iTableRow
End Sub