{"id":279,"date":"2015-08-13T00:10:28","date_gmt":"2015-08-13T06:10:28","guid":{"rendered":"http:\/\/agiltools.com\/blogsp\/?p=279"},"modified":"2015-08-31T07:05:35","modified_gmt":"2015-08-31T13:05:35","slug":"stockexcel","status":"publish","type":"post","link":"https:\/\/agiltools.com\/blogsp\/stockexcel\/","title":{"rendered":"Macro para obtener historico de precios de una accion en Excel"},"content":{"rendered":"

\"[<\/a>

[ File # csp9666250, License # 2222627 ]
Licensed through http:\/\/www.canstockphoto.com in accordance with the End User License Agreement (http:\/\/www.canstockphoto.com\/legal.php)
(c) Can Stock Photo Inc. \/ bbbar<\/p><\/div>Este programa permite\u00a0descargar cualquier\u00a0serie de precios disponible\u00a0Yahoo Finanzas<\/a> directamente a Excel con solo conocer el s\u00edmbolo de la acci\u00f3n. Antes de comenzar es importante adicionar la referencia Microsoft XML en el m\u00f3dulo VBA accediendo con el m\u00e9todo abreviado Alt+F11, luego haciendo click en Tools + Reference y buscar la referencia (ver imagen) la cu\u00e1l permite importar y manipular archivos en formato XML.<\/p>\n

\"ReferencesYahooFinances\"<\/a><\/p>\n

La\u00a0macro central de este programa se compone de varios elementos. El primero es la subrutina\u00a0que\u00a0genera la consulta\u00a0llamada\u00a0GetYahooFinanceTable (ver c\u00f3digo a continuaci\u00f3n).<\/p>\n

Sub GetYahooFinanceTable()\r\n    Dim s1 As Worksheet\r\n    Set s1 = Sheets(ActiveSheet.Index)\r\n    Range(\"A:I\").Select\r\n    Selection.ClearContents\r\n    Range(\"A1\").Select\r\n    Dim sURL As String, sResult As String\r\n    Dim oResult As Variant, oData As Variant, r As Long, C As Long\r\n    sURL = \"http:\/\/ichart.finance.yahoo.com\/table.txt?s=\" & LCase(s1.Cells(2, 10))\r\n    Debug.Print \"URL: \" & sURL\r\n    sResult = GetHTTPResult(sURL)\r\n    oResult = Split(sResult, vbLf)\r\n    Debug.Print \"Lines of result: \" & UBound(oResult)\r\n    For r = 0 To UBound(oResult)\r\n        oData = Split(oResult(r), \",\")\r\n        For C = 0 To UBound(oData)\r\n            ActiveSheet.Cells(r + 1, C + 1) = oData(C)\r\n        Next\r\n    Next\r\n    Set oResult = Nothing\r\n    Range(\"A1\").Select\r\n    Selection.End(xlDown).Select\r\n    Dim l As Long\r\n    l = Selection.Row\r\n    ActiveWorkbook.Worksheets(s1.Name).Sort.SortFields.Add Key:=Range(\"A1\"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal\r\n    With ActiveWorkbook.Worksheets(s1.Name).Sort\r\n        .SetRange Range(Cells(2, 1), Cells(l, 7))\r\n        .Header = xlNo\r\n        .MatchCase = False\r\n        .Orientation = xlTopToBottom\r\n        .SortMethod = xlPinYin\r\n        .Apply\r\n    End With\r\n    Range(\"A1\").Select\r\n    Call UpdatePriceData(True, 9, 10)\r\n    MsgBox (\"Ok!\")\r\nEnd Sub<\/pre>\n
La macro obtiene la informaci\u00f3n utilizando\u00a0APIs\u00a0de Yahoo Finanzas (lea aqu\u00ed <\/a>el wiki de los APIs de Yahoo finanzas). Un API que traducido al espa\u00f1ol significa Interfaz de programaci\u00f3n de aplicaciones,\u00a0es un conjunto de subrutinas predefinidas\u00a0que puede ser utilizado por otro software\u00a0de manera abreviada (Wikipedia\u00a0API<\/a>) en este caso para\u00a0descargar datos de Yahoo\u00a0(lea aqu\u00ed un blog <\/a>sobre como utilizar el API de Yahoo finanzas para archivos CSV).<\/p>\n
Para utilizar el API simplemente construimos el query con los par\u00e1metros deseados, en este caso solamente necesitamos el c\u00f3digo de la acci\u00f3n almacenado en la celda J2 (2, 10). Utilizemos como ejemplo la acci\u00f3n de 3M (MMM). El comando requerido por el API ser\u00e1\u00a0http:\/\/ichart.finance.yahoo.com\/table.txt?s=mmm<\/a>. Si usted introduce este c\u00f3digo en su explorador podr\u00e1 descargar un archivo de texto con el hist\u00f3rico de precios.<\/p>\n
GetYahooFinanceTable ejecuta\u00a0a su vez la funci\u00f3n\u00a0GetHTTPResult y la subrutina\u00a0UpdatePriceData. La funci\u00f3n permite crear la consulta (query) en formato XMLHTTP y lanzarla a la web.<\/p>\n
Function GetHTTPResult(sURL As String) As String\r\n    Dim XMLHTTP As Variant, sResult As String\r\n    Set XMLHTTP = CreateObject(\"WinHttp.WinHttpRequest.5.1\")\r\n    XMLHTTP.Open \"GET\", sURL, False\r\n    XMLHTTP.send\r\n    Debug.Print \"Status: \" & XMLHTTP.Status & \" - \" & XMLHTTP.statusText\r\n    sResult = XMLHTTP.responseText\r\n    Debug.Print \"Length of response: \" & Len(sResult)\r\n    Set XMLHTTP = Nothing\r\n    GetHTTPResult = sResult\r\nEnd Function<\/pre>\n
La subrutina\u00a0UpdatePriceData prepara y llena los vectores con el resultado de la consulta. Para\u00a0ello llama a la funci\u00f3n\u00a0GetQuoteXmlFromWeb y la subrutina\u00a0GetQuoteFromXml.<\/p>\n
Sub UpdatePriceData(Optional manageCalcStatus As Boolean = True, Optional r As Integer = 2, Optional cc As Integer = 1)\r\n    Dim stockXml As MSXML2.IXMLDOMNode\r\n    Dim stockData(5) As Double ' Open, High, Low, Current\/Close, Volume\r\n    Dim stockDate As Date   ' Last Trade Date\r\n    Dim stockTime As Date   ' Last Trade time\r\n    \r\n    sbState = Application.DisplayStatusBar  \r\n    Application.DisplayStatusBar = True     \r\n    Application.StatusBar = \"Preparing quote request...\"\r\n    If manageCalcStatus Then\r\n        appCalcStatus = Application.Calculation\r\n        Application.Calculation = xlCalculationManual\r\n    End If\r\n    Range(Cells(r - 1, cc), Cells(r - 1, cc)).Select\r\n    Selection.End(xlDown).Select\r\n    iRowLast = ActiveCell.Row\r\n    For i = r To iRowLast\r\n        Range(Cells(i, cc), Cells(i, cc)).Select\r\n        Application.StatusBar = \"Get quote for: \" & ActiveCell.Value\r\n        Set stockXml = GetQuoteXmlFromWeb(ActiveCell.Value)\r\n        If stockXml Is Nothing Then\r\n            For n = 0 To UBound(stockData) - 1\r\n                stockData(n) = 0\r\n            Next n\r\n            stockDate = Date\r\n            stockTime = 0\r\n        Else\r\n            stockData(0) = Val(GetQuoteFromXml(stockXml, \"Open\"))\r\n            stockData(1) = Val(GetQuoteFromXml(stockXml, \"DaysHigh\"))\r\n            stockData(2) = Val(GetQuoteFromXml(stockXml, \"DaysLow\"))\r\n            stockData(3) = Val(GetQuoteFromXml(stockXml, \"LastTradePriceOnly\"))\r\n            stockData(4) = Val(GetQuoteFromXml(stockXml, \"Volume\"))\r\n            stockDate = CDate(GetQuoteFromXml(stockXml, \"LastTradeDate\"))\r\n            stockTime = TimeValue(GetQuoteFromXml(stockXml, \"LastTradeTime\"))\r\n            stockName = (GetQuoteFromXml(stockXml, \"Name\"))\r\n            Application.StatusBar = \"Get quote for: \" & ActiveCell.Value\r\n        End If\r\n        For n = 0 To UBound(stockData) - 1\r\n            Cells(i, cc + n + 1) = stockData(n)\r\n        Next n\r\n         Cells(i, cc + n + 1) = stockDate\r\n         Cells(i, cc + n + 2) = stockTime\r\n         Cells(i, cc + n + 3) = stockName\r\n    Next i\r\n        \r\n    If manageCalcStatus Then\r\n        Application.StatusBar = \"Resetting calculation state...\"\r\n        Application.Calculation = appCalcStatus  \r\n    End If\r\n    Application.StatusBar = False    \r\n    Application.DisplayStatusBar = sbState\r\nEnd Sub<\/pre>\n
La funci\u00f3n\u00a0GetQuoteXmlFromWeb es la que\u00a0descarga la informaci\u00f3n en archivo XML y lo traduce. Un archivo XML es\u00a0una estructura anidada de datos (padre e hijo) lo que permite manipular m\u00faltiples dimensiones y gran cantidad de informaci\u00f3n. Desafortunadamente no es tan simple descifrar la estructura por lo que utilizamos una funci\u00f3n para descifrar la relaci\u00f3n jer\u00e1rquica de datos (ver funci\u00f3n\u00a0FindChildNodeName al final).<\/p>\n
Function GetQuoteXmlFromWeb(stockSymbol As String) As MSXML2.IXMLDOMNode\r\n    Dim QuoteXMLstream As MSXML2.DOMDocument\r\n    Dim QuoteXMLHttp As MSXML2.XMLHTTP60\r\n    Dim oChild As MSXML2.IXMLDOMNode\r\n    Dim fSuccess As Boolean\r\n    Dim URL As String\r\n\r\n    On Error GoTo HandleErr    \r\n    ' create the URL that requests the XML stream from Yahoo Finance\r\n    URL = \"http:\/\/query.yahooapis.com\/v1\/public\/yql?q=SELECT%20*%20FROM%20yahoo.finance.quotes%20WHERE%20symbol%3D'\" & Trim(stockSymbol) & \"'\"\r\n    URL = URL & \"&diagnostics=false&env=store%3A%2F%2Fdatatables.org%2Falltableswithkeys\"\r\n    \r\n    ' pull in the XML stream\r\n    Set QuoteXMLHttp = New MSXML2.XMLHTTP60\r\n    With QuoteXMLHttp\r\n        Call .Open(\"GET\", URL, False)\r\n        Call .send\r\n    End With\r\n    fSuccess = QuoteXMLHttp.Status\r\n    If Not fSuccess Then    \r\n      MsgBox \"error loading Yahoo Finance XML stream\"\r\n      Exit Function\r\n    End If\r\n    \r\n    ' Turn it into an XML document\r\n    Set QuoteXMLstream = New MSXML2.DOMDocument\r\n    fSuccsss = QuoteXMLstream.LoadXML(QuoteXMLHttp.responseText)\r\n   \r\n    If Not fSuccess Then                          ' quit on failure\r\n      MsgBox \"error parsing Yahoo Finance XML stream\"\r\n      Exit Function\r\n    End If\r\n    \r\n    ' Structure is: query.results.quote (3 children in) to get to our quote params\r\n    Set oChild = FindChildNodeName(QuoteXMLstream.ChildNodes, \"query\")\r\n    If oChild Is Nothing Then\r\n      MsgBox \"error loading Yahoo Finance XML stream: cannot find 'query'\"\r\n      Exit Function\r\n    End If\r\n    \r\n    Set oChild = FindChildNodeName(oChild.ChildNodes, \"results\")\r\n    If oChild Is Nothing Then\r\n      MsgBox \"error loading Yahoo Finance XML stream: cannot find 'results'\"\r\n      Exit Function\r\n    End If\r\n    ' If this works, we will have the XML quote data node -- our target\r\n    Set oChild = FindChildNodeName(oChild.ChildNodes, \"quote\")\r\n    \r\n    Set GetQuoteXmlFromWeb = oChild     ' Either the node or NOTHING\r\n        \r\n' error handlers\r\nExitHere:\r\n            Exit Function\r\nHandleErr:\r\n            MsgBox \"GetQuoteXmlFromWeb Error \" & Err.Number & \": \" & Err.Description\r\n            Resume ExitHere\r\nEnd Function<\/pre>\n
 <\/p>\n
Function FindChildNodeName(xmlChildren As MSXML2.IXMLDOMNodeList, childName As String) As MSXML2.IXMLDOMNode\r\n    Dim oChild As MSXML2.IXMLDOMNode\r\n    Dim childResult As MSXML2.IXMLDOMNode\r\n    Set childResult = Nothing\r\n    For i = 1 To xmlChildren.Length\r\n        Set oChild = xmlChildren.Item(i - 1)    ' 0-based index\r\n        If oChild.nodeName = childName Then\r\n            Set childResult = oChild\r\n            Exit For\r\n        End If\r\n    Next\r\n    Set FindChildNodeName = childResult\r\nEnd Function<\/pre>\n
Finalmente, la funci\u00f3n GetQuoteFromXml es una adici\u00f3n que bien puede ser opcional. Su utilidad es lanzar una nueva consulta que permite conocer los datos b\u00e1sicos de la acci\u00f3n, como el nombre, el \u00faltimo volumen transado, el mayor y menor valor de transacci\u00f3n del d\u00eda, el \u00faltimo valor de transacci\u00f3n\u00a0y la \u00faltima hora de actualizaci\u00f3n. Si bien una buena parte de la informaci\u00f3n se encuentra en la serie de precios, esta funci\u00f3n es \u00fatil cuando se tiene el s\u00edmbolo y no se conoce el nombre exacto, o cuando se lanza la consulta y los mercados est\u00e1n a\u00fan abiertos por tanto no se conoce el precio de cierre de la acci\u00f3n. La siguiente es la funci\u00f3n:<\/p>\n
Function GetQuoteFromXml(stockXml As MSXML2.IXMLDOMNode, Optional QuoteParameter As String = \"LastTradePriceOnly\", Optional statusText As String = \"\") As String\r\n    Dim oChild As MSXML2.IXMLDOMNode\r\n    Dim sText As String\r\n    On Error GoTo HandleErr\r\n    If statusText <> \"\" Then\r\n        sText = statusText & \" - \" & QuoteParameter\r\n    Else\r\n        sText = \"\"\r\n    End If\r\n    For Each oChild In stockXml.ChildNodes\r\n        If sText <> \"\" Then\r\n            Application.StatusBar = sText & \" (found \" & oChild.nodeName & \")\"\r\n        End If\r\n        If oChild.nodeName = QuoteParameter Then\r\n            s = oChild.Text\r\n            GetQuoteFromXml = s\r\n            If sText <> \"\" Then Application.StatusBar = sText\r\n            Exit Function\r\n        End If\r\n    Next oChild\r\n    If sText <> \"\" Then Application.StatusBar = sText & \" not found!\"\r\n' error handlers\r\nExitHere:\r\n     Exit Function\r\nHandleErr:\r\n            MsgBox \"GetQuoteFromXml Error \" & Err.Number & \": \" & Err.Description\r\n            Resume ExitHere\r\n            Resume\r\nEnd Function<\/pre>\n
Lo dem\u00e1s es est\u00e9tico y a gusto del usuario, una vez la serie se carga en la hoja de c\u00e1lculo se pueden crear gr\u00e1ficos, estad\u00edsticas y dem\u00e1s. Usted puede descargar una versi\u00f3n comprimida de esta macro con algunas adiciones en el siguiente<\/span> link<\/a><\/strong>. Una vez funcional\u00a0la macro usted tendr\u00e1 un reporte como el presentado a continuaci\u00f3n.<\/p>\n
\"quote\"<\/a><\/p>\n
 <\/p>\n
Comentarios finales:<\/strong><\/p>\n