gistfile1.vb

Function LTGrowth(company As String, provider As String) As Double
  
Application.Volatile (False)
Dim address As String
Dim OpenTag, CloseTag, PreTag1, PreTag2 As String
Dim StartPos, InnerLen As Integer
  
If UCase(provider) = "MORNINGSTAR" Then

    address = "http://financials.morningstar.com/valuation/forward-comparisons-list.action?&t=" & company & "&region=usa&culture=en-US"
End If

If UCase(provider) = "ZACKS" Then

    address = "http://www.zacks.com/stock/quote/" & company & "/detailed-estimates"
End If

If UCase(provider) = "REUTERS" Then

    address = "http://www.reuters.com/finance/stocks/analyst?symbol=" & company
End If

If UCase(provider) = "IDC" Then

    address = "http://www.thestreet.com/quote/" & company & "/details/growth-rates.html"
End If
    
    
Dim objHttp As Object
Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
objHttp.Open "GET", address, False
objHttp.Send ""

Dim RawText As String
RawText = objHttp.ResponseText

If UCase(provider) = "MORNINGSTAR" Then

    OpenTag = "<td align=""right"" id=""stocktdone"">"
    CloseTag = "</td>"


    StartPos = InStr(1, RawText, OpenTag)
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - (StartPos)
End If

If UCase(provider) = "ZACKS" Then

    'PreTag1 = "<td class=""row"">Expected Earnings Growth</td>"
    'OpenTag = "<td class=""right""><span>"
    'CloseTag = "%</span></td>"
    PreTag1 = "<td class=""alpha"">Next 5 Years</td>"
    OpenTag = "<td>"
    CloseTag = "</td>"


    StartPos = InStr(InStr(1, RawText, PreTag1), RawText, OpenTag)
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
End If

If UCase(provider) = "REUTERS" Then

    PreTag1 = "<td>LT Growth Rate (%)</td>"
    PreTag2 = "</td>"
    OpenTag = "<td class=""data"">"
    CloseTag = "</td>"


    StartPos = InStr(InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, PreTag2) + Len(PreTag2), RawText, OpenTag)
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
End If

If UCase(provider) = "IDC" Then

    PreTag1 = "VALUE_LIST2="
    PreTag2 = ";"
    OpenTag = ";"
    CloseTag = "&VALUE_LIST3"


    StartPos = InStr(InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, PreTag2) + Len(PreTag2), RawText, OpenTag)
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
End If

LTGrowth = Val(Mid(RawText, StartPos, InnerLen))
   
End Function

Function DivYield(company As String, provider As String) As Double
  
Application.Volatile (False)
Dim address As String
Dim OpenTag, CloseTag, PreTag1, PreTag2 As String
Dim StartPos, InnerLen As Integer
  
'Morningstar.com
If UCase(provider) = "MORNINGSTAR" Then
    address = "http://financials.morningstar.com/valuation/current-valuation-list.action?&t=" & company & "&region=usa&culture=en-US"
End If

'Zacks.com
If UCase(provider) = "ZACKS" Then
    address = "http://www.zacks.com/stock/quote/" & company
End If

'Reuters.com
If UCase(provider) = "REUTERS" Then
    address = "http://www.reuters.com/finance/stocks/overview?symbol=" & company
End If

'TheStreet.com
If UCase(provider) = "IDC" Then
    address = "http://www.thestreet.com/quote/" & company & "/details/company-profile.html"
End If
    
    
Dim objHttp As Object
Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
objHttp.Open "GET", address, False
objHttp.Send ""

Dim RawText As String
RawText = objHttp.ResponseText

'Morningstar.com
If UCase(provider) = "MORNINGSTAR" Then
    PreTag1 = "<th scope=""row"" class=""row_lbl"">Dividend Yield %</th>"
    OpenTag = "<td align=""right"">"
    CloseTag = "</td>"
    StartPos = InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, OpenTag)
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
End If

'Zacks.com
If UCase(provider) = "ZACKS" Then
    'PreTag1 = "<td class=""row"">Div - Yield</td>"
    'PreTag2 = "<td class=""right""><span>"
    'OpenTag = " - "
    'CloseTag = "</span></td>"
    
    PreTag1 = "<td class=""alpha"">Dividend</td>"
    PreTag2 = ""
    OpenTag = "("
    CloseTag = "%)"
    
    StartPos = InStr(InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, PreTag2) + Len(PreTag2), RawText, OpenTag)
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
End If

'Reuters.com
If UCase(provider) = "REUTERS" Then
    PreTag1 = "<td>Yield (%):</td>"
    OpenTag = "<td class=""data""><strong>"
    CloseTag = "</strong>"
    StartPos = InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, OpenTag)
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
End If

'TheStreet.com
If UCase(provider) = "IDC" Then
    PreTag1 = "<td>Yield % </td>"
    OpenTag = "<td class='IDMS_rightcap'>"
    CloseTag = "</td>"
    StartPos = InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, OpenTag)
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
End If

DivYield = Val(Mid(RawText, StartPos, InnerLen))
   
End Function


Function MarketCap(company As String, provider As String) As Double
  
Application.Volatile (False)
Dim address As String
Dim OpenTag, CloseTag, PreTag1, PreTag2, PreTag3 As String
Dim StartPos, InnerLen, Divisor  As Integer

  
'Morningstar.com
If UCase(provider) = "MORNINGSTAR" Then
    address = "http://financials.morningstar.com/company-profile/component.action?component=BasicData&t=" & company & "&region=usa&culture=en-US"
End If

'Zacks.com
If UCase(provider) = "ZACKS" Then
    address = "http://www.zacks.com/stock/quote/" & company
End If

'Reuters.com
If UCase(provider) = "REUTERS" Then
    address = "http://www.reuters.com/finance/stocks/overview?symbol=" & company
End If

'TheStreet.com
If UCase(provider) = "IDC" Then
    address = "http://www.thestreet.com/quote/" & company & "/details/company-profile.html"
End If
    
    
Dim objHttp As Object
Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
objHttp.Open "GET", address, False
objHttp.Send ""

Dim RawText As String
RawText = objHttp.ResponseText

'Morningstar.com
If UCase(provider) = "MORNINGSTAR" Then
    PreTag1 = "<tr class=""text3 padding_b_24px"">"
    PreTag2 = "</td>"
    PreTag3 = "</td>"
    OpenTag = "<td>"
    CloseTag = "Bil</td>"
    StartPos = InStr(InStr(InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, PreTag2) + Len(PreTag2), RawText, PreTag3) + Len(PreTag3), RawText, OpenTag)
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
    Divisor = 1
End If

'Zacks.com
If UCase(provider) = "ZACKS" Then
    PreTag1 = "<td class=""alpha"">Market Cap</td>"
    OpenTag = "<td><span>"
    CloseTag = " B</span></td>"
    StartPos = InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, OpenTag)
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
    Divisor = 1
End If

'Reuters.com
If UCase(provider) = "REUTERS" Then
    PreTag1 = "<td>Market Cap (Mil.):</td>"
    OpenTag = "<td class=""data""><strong>&#36;"
    CloseTag = "</strong></td>"
    StartPos = InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, OpenTag)
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
    Divisor = 1000
End If

'TheStreet.com
If UCase(provider) = "IDC" Then
    PreTag1 = "<td>Mkt Cap (Mil) </td>"
    OpenTag = "<td class=""IDMS_rightcap"">"
    CloseTag = "</td>"
    StartPos = InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, OpenTag)
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
    Divisor = 1000
End If

MarketCap = Val(Replace(Mid(RawText, StartPos, InnerLen), ",", "")) / Divisor
   
End Function

Function Beta(company As String, provider As String) As Double
  
Application.Volatile (False)
Dim address As String
Dim OpenTag, CloseTag, PreTag1, PreTag2, PreTag3 As String
Dim StartPos, InnerLen As Integer

  
'Morningstar.com
If UCase(provider) = "MORNINGSTAR" Then
    address = "http://quotes.morningstar.com/stock/c-marketData?&t=" & company & "&region=usa&culture=en-US"
End If

'Zacks.com
If UCase(provider) = "ZACKS" Then
    address = "http://www.zacks.com/stock/quote/" & company
End If

'Reuters.com
If UCase(provider) = "REUTERS" Then
    address = "http://www.reuters.com/finance/stocks/overview?symbol=" & company
End If

'TheStreet.com
If UCase(provider) = "IDC" Then
    address = "http://www.thestreet.com/quote/" & company & "/details/company-profile.html"
End If
    
    
Dim objHttp As Object
Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
objHttp.Open "GET", address, False
objHttp.Send ""

Dim RawText As String
RawText = objHttp.ResponseText

'Morningstar.com
If UCase(provider) = "MORNINGSTAR" Then
    PreTag1 = "<td class=""gr_table_colm10"">Beta</td>"
'   PreTag2 = ""
'   PreTag3 = ""
    OpenTag = "<td class=""gr_table_colm1b"">"
    CloseTag = "</td>"
'   StartPos = InStr(1, RawText, OpenTag)                                                                                                                           'No Pretags
    StartPos = InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, OpenTag)                                                                                   '1 Pretag
'   StartPos = InStr(InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, PreTag2) + Len(PreTag2), RawText, OpenTag)                                           '2 Pretags
'   StartPos = InStr(InStr(InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, PreTag2) + Len(PreTag2), RawText, PreTag3) + Len(PreTag3), RawText, OpenTag)   '3 Pretags
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
End If

'Zacks.com
If UCase(provider) = "ZACKS" Then
    PreTag1 = "<td class=""alpha"">Beta</td>"
    OpenTag = "<td><span>"
    CloseTag = "</span></td>"
    StartPos = InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, OpenTag)                                                                                   '1 Pretag
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
End If

'Reuters.com
If UCase(provider) = "REUTERS" Then
    PreTag1 = "<td>Beta:</td>"
'   PreTag2 = ""
'   PreTag3 = ""
    OpenTag = "<td class=""data""><strong>"
    CloseTag = "</strong></td>"
'   StartPos = InStr(1, RawText, OpenTag)                                                                                                                           'No Pretags
    StartPos = InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, OpenTag)                                                                                   '1 Pretag
'   StartPos = InStr(InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, PreTag2) + Len(PreTag2), RawText, OpenTag)                                           '2 Pretags
'   StartPos = InStr(InStr(InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, PreTag2) + Len(PreTag2), RawText, PreTag3) + Len(PreTag3), RawText, OpenTag)   '3 Pretags
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
End If

'TheStreet.com
If UCase(provider) = "IDC" Then
    PreTag1 = "<td>Beta (3 year) </td>"
'   PreTag2 = ""
'   PreTag3 = ""
    OpenTag = "<td class='IDMS_rightcap'>"
    CloseTag = "</td>"
'   StartPos = InStr(1, RawText, OpenTag)                                                                                                                           'No Pretags
    StartPos = InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, OpenTag)                                                                                   '1 Pretag
'   StartPos = InStr(InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, PreTag2) + Len(PreTag2), RawText, OpenTag)                                           '2 Pretags
'   StartPos = InStr(InStr(InStr(InStr(1, RawText, PreTag1) + Len(PreTag1), RawText, PreTag2) + Len(PreTag2), RawText, PreTag3) + Len(PreTag3), RawText, OpenTag)   '3 Pretags
    StartPos = StartPos + Len(OpenTag)
    InnerLen = InStr(StartPos, RawText, CloseTag) - StartPos
End If

Beta = Val(Replace(Mid(RawText, StartPos, InnerLen), ",", ""))
   
End Function