diff --git a/Get Started.xlsm b/Get Started.xlsm new file mode 100644 index 0000000..44809f9 Binary files /dev/null and b/Get Started.xlsm differ diff --git a/Intrinio_Excel_Addin.xlam b/Intrinio_Excel_Addin.xlam index 421ea3a..4989e7d 100644 Binary files a/Intrinio_Excel_Addin.xlam and b/Intrinio_Excel_Addin.xlam differ diff --git a/lib/VBA-Dictionary/Dictionary.cls b/lib/VBA-Dictionary/Dictionary.cls index 4dd4f96..1be3c2a 100644 --- a/lib/VBA-Dictionary/Dictionary.cls +++ b/lib/VBA-Dictionary/Dictionary.cls @@ -7,8 +7,9 @@ Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True +Attribute VB_Description = "Drop-in replacement for Scripting.Dictionary on Mac\r\n\r\nDictionary v1.4.0\r\n(c) Tim Hall - https://github.com/timhall/VBA-Dictionary\r\nAuthor: tim.hall.engr@gmail.com\r\nLicense: MIT (http://www.opensource.org/licenses/mit-license.php)\r\n" '' -' Dictionary v1.4.0 +' Dictionary v1.4.1 ' (c) Tim Hall - https://github.com/timhall/VBA-Dictionary ' ' Drop-in replacement for Scripting.Dictionary on Mac @@ -55,6 +56,7 @@ End Enum ' --------------------------------------------- ' Public Property Get CompareMode() As CompareMethod +Attribute CompareMode.VB_Description = "Set or get the string comparison method." #If Mac Or Not UseScriptingDictionaryIfAvailable Then CompareMode = dict_pCompareMode #Else @@ -76,6 +78,7 @@ Public Property Let CompareMode(Value As CompareMethod) End Property Public Property Get Count() As Long +Attribute Count.VB_Description = "Get the number of items in the dictionary.\n" #If Mac Or Not UseScriptingDictionaryIfAvailable Then Count = dict_pKeyValues.Count #Else @@ -84,6 +87,7 @@ Public Property Get Count() As Long End Property Public Property Get Item(Key As Variant) As Variant +Attribute Item.VB_Description = "Set or get the item for a given key." Attribute Item.VB_UserMemId = 0 #If Mac Or Not UseScriptingDictionaryIfAvailable Then Dim dict_KeyValue As Variant @@ -130,6 +134,7 @@ Public Property Set Item(Key As Variant, Value As Variant) End Property Public Property Let Key(Previous As Variant, Updated As Variant) +Attribute Key.VB_Description = "Change a key to a different key." #If Mac Or Not UseScriptingDictionaryIfAvailable Then Dim dict_KeyValue As Variant dict_KeyValue = dict_GetKeyValue(Previous) @@ -153,6 +158,7 @@ End Property ' @param {Variant} Item ' --------------------------------------------- ' Public Sub Add(Key As Variant, Item As Variant) +Attribute Add.VB_Description = "Add a new key and item to the dictionary." #If Mac Or Not UseScriptingDictionaryIfAvailable Then If Not Me.Exists(Key) Then dict_AddKeyValue Key, Item @@ -172,6 +178,7 @@ End Sub ' @return {Boolean} ' --------------------------------------------- ' Public Function Exists(Key As Variant) As Boolean +Attribute Exists.VB_Description = "Determine if a given key is in the dictionary." #If Mac Or Not UseScriptingDictionaryIfAvailable Then Exists = Not IsEmpty(dict_GetKeyValue(Key)) #Else @@ -185,6 +192,7 @@ End Function ' @return {Variant} ' --------------------------------------------- ' Public Function Items() As Variant +Attribute Items.VB_Description = "Get an array containing all items in the dictionary." #If Mac Or Not UseScriptingDictionaryIfAvailable Then If Me.Count > 0 Then Items = dict_pItems @@ -203,6 +211,7 @@ End Function ' @return {Variant} ' --------------------------------------------- ' Public Function Keys() As Variant +Attribute Keys.VB_Description = "Get an array containing all keys in the dictionary." #If Mac Or Not UseScriptingDictionaryIfAvailable Then If Me.Count > 0 Then Keys = dict_pKeys @@ -221,6 +230,7 @@ End Function ' @param {Variant} Key ' --------------------------------------------- ' Public Sub Remove(Key As Variant) +Attribute Remove.VB_Description = "Remove a given key from the dictionary." #If Mac Or Not UseScriptingDictionaryIfAvailable Then Dim dict_KeyValue As Variant dict_KeyValue = dict_GetKeyValue(Key) @@ -240,6 +250,7 @@ End Sub ' Remove all items ' --------------------------------------------- ' Public Sub RemoveAll() +Attribute RemoveAll.VB_Description = "Remove all information from the dictionary." #If Mac Or Not UseScriptingDictionaryIfAvailable Then Set dict_pKeyValues = New Collection diff --git a/lib/VBA-Dictionary/specs/VBA-Dictionary - Specs.xlsm b/lib/VBA-Dictionary/specs/VBA-Dictionary - Specs.xlsm index 6c84700..b7dc082 100644 Binary files a/lib/VBA-Dictionary/specs/VBA-Dictionary - Specs.xlsm and b/lib/VBA-Dictionary/specs/VBA-Dictionary - Specs.xlsm differ diff --git a/lib/VBA-Web/CHANGELOG.md b/lib/VBA-Web/CHANGELOG.md index b62c849..a375fb5 100644 --- a/lib/VBA-Web/CHANGELOG.md +++ b/lib/VBA-Web/CHANGELOG.md @@ -30,6 +30,7 @@ Major Changes: - __4.0.19__ Fix installer and update VBA-JSON to v1.0.3 - __4.0.20__ Update VBA-JSON to v2.0.1 (Note: Breaking change in VBA-JSON, Solidus is no longer escaped by default) - __4.0.21__ Fix `vbCrLf` issue in Excel for Mac 2016 and namespace internal method calls +- __4.0.22__ Add `Request.UserAgent`, sort OAuth1 querystring parameters, fix `UrlEncode` issues, and `WebClient` tweaks Breaking Changes: diff --git a/lib/VBA-Web/README.md b/lib/VBA-Web/README.md index 05a29a4..c119d46 100644 --- a/lib/VBA-Web/README.md +++ b/lib/VBA-Web/README.md @@ -6,7 +6,7 @@ VBA-Web (formerly Excel-REST) makes working with complex webservices and APIs ea Getting started --------------- -- Download the [latest release (v4.0.21)](https://github.com/VBA-tools/VBA-Web/releases) +- Download the [latest release (v4.0.22)](https://github.com/VBA-tools/VBA-Web/releases) - To install/upgrade in an existing file, use `VBA-Web - Installer.xlsm` - To start from scratch in Excel, `VBA-Web - Blank.xlsm` has everything setup and ready to go @@ -151,9 +151,9 @@ Function QueryTwitter(Query As String) As WebResponse Request.Resource = "search/tweets.json" Request.Format = WebFormat.Json Request.Method = WebMethod.HttpGet - Request.AddParameter "q", Query - Request.AddParameter "lang", "en" - Request.AddParameter "count", 20 + Request.AddQuerystringParam "q", Query + Request.AddQuerystringParam "lang", "en" + Request.AddQuerystringParam "count", 20 ' => GET https://api.twitter.com/1.1/search/tweets.json?q=...&lang=en&count=20 ' Authorization Bearer Token... (received and added automatically via TwitterAuthenticator) diff --git a/lib/VBA-Web/VBA-Web - Blank.xlsm b/lib/VBA-Web/VBA-Web - Blank.xlsm index bc345d3..f8e7072 100644 Binary files a/lib/VBA-Web/VBA-Web - Blank.xlsm and b/lib/VBA-Web/VBA-Web - Blank.xlsm differ diff --git a/lib/VBA-Web/VBA-Web - Installer.xlsm b/lib/VBA-Web/VBA-Web - Installer.xlsm index b8bf321..cbc3b6a 100644 Binary files a/lib/VBA-Web/VBA-Web - Installer.xlsm and b/lib/VBA-Web/VBA-Web - Installer.xlsm differ diff --git a/lib/VBA-Web/authenticators/OAuth1Authenticator.cls b/lib/VBA-Web/authenticators/OAuth1Authenticator.cls index 4bf2c14..69a75ce 100644 --- a/lib/VBA-Web/authenticators/OAuth1Authenticator.cls +++ b/lib/VBA-Web/authenticators/OAuth1Authenticator.cls @@ -171,20 +171,21 @@ End Function '' Public Function CreateBaseString(auth_Nonce As String, auth_Timestamp As String, auth_Client As WebClient, auth_Request As WebRequest) As String Dim auth_Base As String - Dim auth_Parameters As String + Dim auth_Parameters() As String - ' Check for parameters and add to auth_Base if present - auth_Parameters = GetRequestParameters(auth_Client, auth_Request) - If auth_Parameters <> "" Then - auth_Base = auth_Parameters & "&" - End If + ' Add and sort parameters + auth_Parameters = VBA.Split(GetRequestParameters(auth_Client, auth_Request), "&") + ReDim Preserve auth_Parameters(UBound(auth_Parameters) + 6) + + auth_Parameters(UBound(auth_Parameters) - 5) = "oauth_consumer_key=" & Me.ConsumerKey + auth_Parameters(UBound(auth_Parameters) - 4) = "oauth_nonce=" & auth_Nonce + auth_Parameters(UBound(auth_Parameters) - 3) = "oauth_signature_method=" & auth_SignatureMethod + auth_Parameters(UBound(auth_Parameters) - 2) = "oauth_timestamp=" & auth_Timestamp + auth_Parameters(UBound(auth_Parameters) - 1) = "oauth_token=" & Me.Token + auth_Parameters(UBound(auth_Parameters)) = "oauth_version=1.0" - auth_Base = auth_Base & "oauth_consumer_key" & "=" & Me.ConsumerKey - auth_Base = auth_Base & "&" & "oauth_nonce" & "=" & auth_Nonce - auth_Base = auth_Base & "&" & "oauth_signature_method" & "=" & auth_SignatureMethod - auth_Base = auth_Base & "&" & "oauth_timestamp" & "=" & auth_Timestamp - auth_Base = auth_Base & "&" & "oauth_token" & "=" & Me.Token - auth_Base = auth_Base & "&" & "oauth_version=1.0" + auth_Parameters = SortParameters(auth_Parameters) + auth_Base = VBA.Join(auth_Parameters, "&") CreateBaseString = WebHelpers.MethodToName(auth_Request.Method) & "&" & _ WebHelpers.UrlEncode(GetRequestUrl(auth_Client, auth_Request), EncodeUnsafe:=False) & "&" & _ @@ -251,16 +252,38 @@ End Function ' @return {String} '' Public Function GetRequestParameters(auth_Client As WebClient, auth_Request As WebRequest) As String - ' TODO Sort parameters by key then value - Dim auth_Parts As Dictionary Set auth_Parts = WebHelpers.GetUrlParts(auth_Client.GetFullUrl(auth_Request)) - ' Remove leading ? - GetRequestParameters = auth_Parts("Querystring") - ' Replace + for spaces with %20 - GetRequestParameters = Replace(GetRequestParameters, "+", "%20") + GetRequestParameters = VBA.Replace(auth_Parts("Querystring"), "+", "%20") +End Function + +'' +' Sort parameters (by value then key) +' +' @internal +' @param {Variant} Parameters +' @return {Variant} +'' +Public Function SortParameters(auth_Parameters As Variant) As Variant + ' Sort by key then value = sort by combined key-value + ' (shouldn't be too many parameters, use naive selection sort + Dim auth_Temp As String + Dim auth_i As Long + Dim auth_j As Long + + For auth_i = LBound(auth_Parameters) To UBound(auth_Parameters) + For auth_j = auth_i To UBound(auth_Parameters) + If auth_Parameters(auth_j) < auth_Parameters(auth_i) Then + auth_Temp = auth_Parameters(auth_i) + auth_Parameters(auth_i) = auth_Parameters(auth_j) + auth_Parameters(auth_j) = auth_Temp + End If + Next auth_j + Next auth_i + + SortParameters = auth_Parameters End Function ' ============================================= ' diff --git a/lib/VBA-Web/examples/VBA-Web - Example.xlsm b/lib/VBA-Web/examples/VBA-Web - Example.xlsm index 15d3db2..3511cbc 100644 Binary files a/lib/VBA-Web/examples/VBA-Web - Example.xlsm and b/lib/VBA-Web/examples/VBA-Web - Example.xlsm differ diff --git a/lib/VBA-Web/examples/gmail/Gmail.bas b/lib/VBA-Web/examples/gmail/Gmail.bas index 338aed9..97a882f 100644 --- a/lib/VBA-Web/examples/gmail/Gmail.bas +++ b/lib/VBA-Web/examples/gmail/Gmail.bas @@ -1,6 +1,32 @@ Attribute VB_Name = "Gmail" -' Setup client and authenticator (cached between requests) +Private pGmailClientId As String +Private pGmailClientSecret As String Private pGmailClient As WebClient + +Private Property Get GmailClientId() As String + If pGmailClientId = "" Then + If Credentials.Loaded Then + pGmailClientId = Credentials.Values("Google")("id") + Else + pGmailClientId = InputBox("Please Enter Google API Client Id") + End If + End If + + GmailClientId = pGmailClientId +End Property +Private Property Get GmailClientSecret() As String + If pGmailClientSecret = "" Then + If Credentials.Loaded Then + pGmailClientSecret = Credentials.Values("Google")("secret") + Else + pGmailClientSecret = InputBox("Please Enter Google API Client Secret") + End If + End If + + GmailClientSecret = pGmailClientSecret +End Property + +' Setup client and authenticator (cached between requests) Private Property Get GmailClient() As WebClient If pGmailClient Is Nothing Then ' Create client with base url that is appended to all requests @@ -12,7 +38,7 @@ Private Property Get GmailClient() As WebClient ' - Get API client id and secret from https://console.developers.google.com/ ' - https://github.com/VBA-tools/VBA-Web/wiki/Google-APIs for more info Dim Auth As New GoogleAuthenticator - Auth.Setup CStr(Credentials.Values("Google")("id")), CStr(Credentials.Values("Google")("secret")) + Auth.Setup CStr(GmailClientId), CStr(GmailClientSecret) Auth.AddScope "https://www.googleapis.com/auth/gmail.readonly" Auth.Login Set pGmailClient.Authenticator = Auth diff --git a/lib/VBA-Web/specs/Specs_OAuth1Authenticator.bas b/lib/VBA-Web/specs/Specs_OAuth1Authenticator.bas index bd27928..da86908 100644 --- a/lib/VBA-Web/specs/Specs_OAuth1Authenticator.bas +++ b/lib/VBA-Web/specs/Specs_OAuth1Authenticator.bas @@ -43,7 +43,7 @@ Public Function Specs() As SpecSuite .Expect(Auth.GetRequestUrl(Client, Request)).ToEqual "http://localhost:3000/a/b/c" End With - With Specs.It("should property format request parameters") + With Specs.It("should properly format request parameters") Set Request = New WebRequest Request.Resource = "resource" Request.AddQuerystringParam "a", True @@ -73,6 +73,16 @@ Public Function Specs() As SpecSuite .Expect(Client.GetFullUrl(Request)).ToEqual "http://localhost:3000/testing?a=a+b" End With + With Specs.It("should sort querystring parameters") + Client.BaseUrl = "HTTP://localhost:3000/testing" + Set Request = New WebRequest + Request.Resource = "?c=Howdy!&b=456" + Request.AddQuerystringParam "d", 789 + Request.AddQuerystringParam "a", 123 + + .Expect(VBA.Join(Auth.SortParameters(VBA.Split(Auth.GetRequestParameters(Client, Request), "&")), "&")).ToEqual "a=123&b=456&c=Howdy!&d=789" + End With + Set Client = New WebClient Set Request = New WebRequest diff --git a/lib/VBA-Web/specs/Specs_WebHelpers.bas b/lib/VBA-Web/specs/Specs_WebHelpers.bas index 358c4d3..1cce46a 100644 --- a/lib/VBA-Web/specs/Specs_WebHelpers.bas +++ b/lib/VBA-Web/specs/Specs_WebHelpers.bas @@ -194,9 +194,10 @@ Public Function Specs() As SpecSuite ' UrlEncode ' --------------------------------------------- ' With Specs.It("should url-encode string (with space as plus and encode unsafe options)") - .Expect(WebHelpers.UrlEncode("$&+,/:;=?@", EncodeUnsafe:=False)).ToEqual "%24%26%2B%2C%2F%3A%3B%3D%3F%40" + .Expect(WebHelpers.UrlEncode("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890$-_.+!*'(),")).ToEqual "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890$-_.+!*'()," + .Expect(WebHelpers.UrlEncode("&/:;=?@")).ToEqual "%26%2F%3A%3B%3D%3F%40" .Expect(WebHelpers.UrlEncode(" ""<>#%{}|\^~[]`")).ToEqual "%20%22%3C%3E%23%25%7B%7D%7C%5C%5E%7E%5B%5D%60" - .Expect(WebHelpers.UrlEncode("A + B")).ToEqual "A%20%2B%20B" + .Expect(WebHelpers.UrlEncode("A + B")).ToEqual "A%20+%20B" .Expect(WebHelpers.UrlEncode("A + B", SpaceAsPlus:=True)).ToEqual "A+%2B+B" End With diff --git a/lib/VBA-Web/specs/Specs_WebRequest.bas b/lib/VBA-Web/specs/Specs_WebRequest.bas index 975447e..083f3c9 100644 --- a/lib/VBA-Web/specs/Specs_WebRequest.bas +++ b/lib/VBA-Web/specs/Specs_WebRequest.bas @@ -228,9 +228,9 @@ Public Function Specs() As SpecSuite Set Request = New WebRequest Request.Resource = "{segment}" - Request.AddUrlSegment "segment", "$&+,/:;=?@" + Request.AddUrlSegment "segment", "&/:;=?@" - .Expect(Request.FormattedResource).ToEqual "%24%26%2B%2C%2F%3A%3B%3D%3F%40" + .Expect(Request.FormattedResource).ToEqual "%26%2F%3A%3B%3D%3F%40" End With With Specs.It("FormattedResource should include querystring parameters") @@ -266,11 +266,12 @@ Public Function Specs() As SpecSuite With Specs.It("FormattedResource should URL encode querystring") Set Request = New WebRequest - Request.AddQuerystringParam "A B", "$&+,/:;=?@" + Request.AddQuerystringParam "A B", "&/:;=?@" - .Expect(Request.FormattedResource).ToEqual "?A+B=%24%26%2B%2C%2F%3A%3B%3D%3F%40" + .Expect(Request.FormattedResource).ToEqual "?A+B=%26%2F%3A%3B%3D%3F%40" End With + ' UserAgent ' Cookies ' Headers ' QuerystringParams diff --git a/lib/VBA-Web/specs/VBA-Web - Specs - Async.xlsm b/lib/VBA-Web/specs/VBA-Web - Specs - Async.xlsm index 14d5eaa..19ffbe8 100644 Binary files a/lib/VBA-Web/specs/VBA-Web - Specs - Async.xlsm and b/lib/VBA-Web/specs/VBA-Web - Specs - Async.xlsm differ diff --git a/lib/VBA-Web/specs/VBA-Web - Specs.xlsm b/lib/VBA-Web/specs/VBA-Web - Specs.xlsm index 07c32cd..8394b2c 100644 Binary files a/lib/VBA-Web/specs/VBA-Web - Specs.xlsm and b/lib/VBA-Web/specs/VBA-Web - Specs.xlsm differ diff --git a/lib/VBA-Web/src/IWebAuthenticator.cls b/lib/VBA-Web/src/IWebAuthenticator.cls index 95219d6..66585bb 100644 --- a/lib/VBA-Web/src/IWebAuthenticator.cls +++ b/lib/VBA-Web/src/IWebAuthenticator.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' IWebAuthenticator v4.0.21 +' IWebAuthenticator v4.0.22 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' Interface for creating authenticators for rest client diff --git a/lib/VBA-Web/src/WebAsyncWrapper.cls b/lib/VBA-Web/src/WebAsyncWrapper.cls index f10d4ee..9c83f20 100644 --- a/lib/VBA-Web/src/WebAsyncWrapper.cls +++ b/lib/VBA-Web/src/WebAsyncWrapper.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' WebAsyncWrapper v4.0.21 +' WebAsyncWrapper v4.0.22 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' Wrapper WebClient and WebRequest that enables callback-style async requests diff --git a/lib/VBA-Web/src/WebClient.cls b/lib/VBA-Web/src/WebClient.cls index abc7dac..450a11d 100644 --- a/lib/VBA-Web/src/WebClient.cls +++ b/lib/VBA-Web/src/WebClient.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' WebClient v4.0.21 +' WebClient v4.0.22 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' `WebClient` executes requests and handles response and is responsible for functionality shared between requests, @@ -253,32 +253,57 @@ Public Function Execute(Request As WebRequest) As WebResponse web_Result = WebHelpers.ExecuteInShell(web_Curl) ' Handle cURL errors + ' + ' Map to WinHttp error number, as possible + ' https://msdn.microsoft.com/en-us/library/aa383770(VS.85).aspx If web_Result.ExitCode > 0 Then Dim web_ErrorNumber As Long Dim web_ErrorMessage As String + Dim web_ErrorDetails As String web_ErrorNumber = web_Result.ExitCode / 256 Select Case web_ErrorNumber Case 1 ' 1 = CURLE_UNSUPPORTED_PROTOCOL - Err.Raise 208614 + vbObjectError, "The URL does not use a recognized protocol (1: CURLE_UNSUPPORTED_PROTOCOL)" & vbNewLine & _ + ' 12006 = ERROR_WINHTTP_UNRECOGNIZED_SCHEME + Err.Raise 12006 + &H30000 + vbObjectError, "The URL does not use a recognized protocol (1: CURLE_UNSUPPORTED_PROTOCOL)" & vbNewLine & _ "URL: " & Me.GetFullUrl(Request) & vbNewLine & _ "Protocol: " & WebHelpers.GetUrlParts(Me.GetFullUrl(Request))("Protocol") Case 3 ' 3 = CURLE_URL_MALFORMAT - Err.Raise 208613 + vbObjectError, "The URL is invalid (3: CURLE_URL_MALFORMAT)" & _ + ' 12005 = ERROR_WINHTTP_INVALID_URL + Err.Raise 12005 + &H30000 + vbObjectError, "The URL is invalid (3: CURLE_URL_MALFORMAT)" & _ "URL: " & Me.GetFullUrl(Request) - Case 5, 6, 7 + Case 5, 6 ' 5 = CURLE_COULDNT_RESOLVE_PROXY ' 6 = CURLE_COULDNT_RESOLVE_HOST - Err.Raise 208615 + vbObjectError, "WebClient.Execute", "The server name or address could not be resolved" + ' 12007 = ERROR_WINHTTP_NAME_NOT_RESOLVED + If web_ErrorNumber = 5 Then + web_ErrorDetails = "(5: CURLE_COULDNT_RESOLVE_PROXY)" + Else + web_ErrorDetails = "(6: CURLE_COULDNT_RESOLVE_HOST)" + End If + + Err.Raise 12007 + &H30000 + vbObjectError, "WebClient.Execute", "The server name or address could not be resolved " & web_ErrorDetails Case 7 ' 7 = CURLE_COULDNT_CONNECT - Err.Raise 208637 + vbObjectError, "WebClient.Execute", "A connection with the server could not be established" + ' 12029 = ERROR_WINHTTP_CANNOT_CONNECT + Err.Raise 12029 + &H30000 + vbObjectError, "WebClient.Execute", "A connection with the server could not be established (7: CURLE_COULDNT_CONNECT)" Case 12, 28 ' 12 = CURLE_FTP_ACCEPT_TIMEOUT ' 28 = CURLE_OPERATION_TIMEDOUT - Err.Raise 208610 + vbObjectError, "WebClient.Execute", "The operation timed out" + ' 12002 = ERROR_WINHTTP_TIMEOUT + If web_ErrorNumber = 12 Then + web_ErrorDetails = "(12: CURLE_FTP_ACCEPT_TIMEOUT)" + Else + web_ErrorDetails = "(28: CURLE_OPERATION_TIMEDOUT)" + End If + + Err.Raise 12002 + &H30000 + vbObjectError, "WebClient.Execute", "The operation timed out " & web_ErrorDetails + Case 47 + ' 47 = CURLE_TOO_MANY_REDIRECTS + ' 12156 = ERROR_WINHTTP_REDIRECT_FAILED + Err.Raise 12156 + &H30000 + vbObjectError, "WebClient.Execute", "Too many redirects (47: CURLE_TOO_MANY_REDIRECTS)" Case Else Err.Raise 11010 + vbObjectError, "WebClient.Execute", "An unknown cURL error occured, #" & web_ErrorNumber & vbNewLine & _ "Find details at http://curl.haxx.se/libcurl/c/libcurl-errors.html" @@ -291,7 +316,7 @@ Public Function Execute(Request As WebRequest) As WebResponse Set web_Http = Me.PrepareHttpRequest(Request) web_Http.Send Request.Body - Do While Not web_Http.WaitForResponse(25) + Do While Not web_Http.WaitForResponse(0.025) VBA.DoEvents Loop @@ -314,11 +339,13 @@ web_ErrorHandling: Set web_Http = Nothing Dim web_ErrorDescription As String - Select Case Err.Number - vbObjectError - Case 208610, 208615, 208637 - ' Return 408 + ' Check lower 16 bits from error + ' (e.g. 80072EE2 -> 2EE2 -> 12002) + Select Case Err.Number And 65535 + Case 12002, 12007, 12029 + ' Treat timeout-related errors as 408: timeout, name not resolved, cannot connect web_Response.StatusCode = WebStatusCode.RequestTimeout - web_Response.StatusDescription = "Request Timeout" + web_Response.StatusDescription = "Request Timeout: " & Err.Description WebHelpers.LogResponse Me, Request, web_Response Set Execute = web_Response diff --git a/lib/VBA-Web/src/WebHelpers.bas b/lib/VBA-Web/src/WebHelpers.bas index e3faf13..fb1d56f 100644 --- a/lib/VBA-Web/src/WebHelpers.bas +++ b/lib/VBA-Web/src/WebHelpers.bas @@ -1,6 +1,6 @@ Attribute VB_Name = "WebHelpers" '' -' WebHelpers v4.0.21 +' WebHelpers v4.0.22 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' Contains general-purpose helpers that are used throughout VBA-Web. Includes: @@ -247,7 +247,7 @@ Private Declare Function web_fread Lib "libc.dylib" Alias "fread" (ByVal outStr Private Declare Function web_feof Lib "libc.dylib" Alias "feof" (ByVal File As Long) As Long #End If -Public Const WebUserAgent As String = "VBA-Web v4.0.21 (https://github.com/VBA-tools/VBA-Web)" +Public Const WebUserAgent As String = "VBA-Web v4.0.22 (https://github.com/VBA-tools/VBA-Web)" ' @internal Public Type ShellResult @@ -812,7 +812,14 @@ End Function '' ' Encode string for URLs -' Reference: http://www.blooberry.com/indexdot/html/topics/urlencoding.htm +' Reference: +' - http://www.blooberry.com/indexdot/html/topics/urlencoding.htm +' - https://www.ietf.org/rfc/rfc1738.txt +' +' From RFC 1738: +' > Thus, only alphanumerics, the special characters "$-_.+!*'(),", and +' reserved characters used for their reserved purposes may be used +' unencoded within a URL. ' ' @method UrlEncode ' @param {Variant} Text Text to encode @@ -850,20 +857,36 @@ Public Function UrlEncode(Text As Variant, Optional SpaceAsPlus As Boolean = Fal web_CharCode = VBA.Asc(web_Char) Select Case web_CharCode - Case 36, 38, 43, 44, 47, 58, 59, 61, 63, 64 - ' Reserved characters - web_Result(web_i) = "%" & VBA.Hex(web_CharCode) - Case 32 - web_Result(web_i) = web_Space - Case 34, 35, 37, 60, 62, 91 To 94, 96, 123 To 126 - ' Unsafe characters - If EncodeUnsafe Then - web_Result(web_i) = "%" & VBA.Hex(web_CharCode) - Else + Case 33, 36, 39, 40, 41, 42, 44, 45, 46, 48 To 57, 65 To 90, 95, 97 To 122 + ' Unencoded: + ' alphanumeric - 48-57, 65-90, 97-122 + ' $-_.!*'(), - 33, 36, 39, 40, 41, 42, 43, 44, 45, 46, 95 web_Result(web_i) = web_Char - End If - Case Else - web_Result(web_i) = web_Char + Case 34, 35, 37, 60, 62, 91 To 94, 96, 123 To 126 + ' Unsafe characters: <>"#%{}|\^~[]` + If EncodeUnsafe Then + web_Result(web_i) = "%" & VBA.Hex(web_CharCode) + Else + web_Result(web_i) = web_Char + End If + Case 32 + If EncodeUnsafe Then + web_Result(web_i) = web_Space + Else + web_Result(web_i) = web_Char + End If + Case 43 + ' + is considered safe special character + ' but in space-as-plus cases, it's encoded to differentiate with space + If EncodeUnsafe And SpaceAsPlus Then + web_Result(web_i) = "%" & VBA.Hex(web_CharCode) + Else + web_Result(web_i) = web_Char + End If + Case 0 To 15 + web_Result(web_i) = "%0" & VBA.Hex(web_CharCode) + Case Else + web_Result(web_i) = "%" & VBA.Hex(web_CharCode) End Select Next web_i UrlEncode = VBA.Join$(web_Result, "") diff --git a/lib/VBA-Web/src/WebRequest.cls b/lib/VBA-Web/src/WebRequest.cls index a1be65e..5e8e403 100644 --- a/lib/VBA-Web/src/WebRequest.cls +++ b/lib/VBA-Web/src/WebRequest.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' WebRequest v4.0.21 +' WebRequest v4.0.22 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' `WebRequest` is used to create detailed requests @@ -176,6 +176,23 @@ Public UrlSegments As Dictionary '' Public Cookies As Collection +'' +' User agent to use with request +' +' @example +' ```VB.net +' Dim Request As New WebRequest +' Request.UserAgent = "Mozilla/5.0" +' +' ' -> (Header) User-Agent: Mozilla/5.0 +' ``` +' +' @property UserAgent +' @type String +' @default "VBA-Web v#.#.# (https://github.com/VBA-tools/VBA-Web)" +'' +Public UserAgent As String + '' ' Set `RequestFormat`, `ResponseFormat`, and `Content-Type` and `Accept` ' headers for the `WebRequest` @@ -708,7 +725,7 @@ End Sub '' Public Sub Prepare() ' Add/replace general headers for request - SetHeader "User-Agent", WebUserAgent + SetHeader "User-Agent", Me.UserAgent SetHeader "Content-Type", Me.ContentType SetHeader "Accept", Me.Accept SetHeader "Content-Length", VBA.CStr(Me.ContentLength) @@ -727,6 +744,7 @@ Public Function Clone() As WebRequest ' Note: Clone underlying for properties with default values Clone.Resource = Me.Resource Clone.Method = Me.Method + Clone.UserAgent = Me.UserAgent Clone.Accept = web_pAccept Clone.ContentType = web_pContentType Clone.ContentLength = web_pContentLength @@ -782,6 +800,7 @@ Private Sub Class_Initialize() ' Set default values Me.RequestFormat = WebFormat.Json Me.ResponseFormat = WebFormat.Json + Me.UserAgent = WebUserAgent Set Me.Headers = New Collection Set Me.QuerystringParams = New Collection diff --git a/lib/VBA-Web/src/WebResponse.cls b/lib/VBA-Web/src/WebResponse.cls index f470486..39842fc 100644 --- a/lib/VBA-Web/src/WebResponse.cls +++ b/lib/VBA-Web/src/WebResponse.cls @@ -8,7 +8,7 @@ Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '' -' WebResponse v4.0.21 +' WebResponse v4.0.22 ' (c) Tim Hall - https://github.com/VBA-tools/VBA-Web ' ' Wrapper for http/cURL responses that includes parsed Data based on WebRequest.ResponseFormat. diff --git a/src/Intrinio.bas b/src/Intrinio.bas index b00239b..d33d84f 100644 --- a/src/Intrinio.bas +++ b/src/Intrinio.bas @@ -3,6 +3,7 @@ Option Explicit Public CompanyDic As New Dictionary Public SecuritiesDic As New Dictionary +Public BankDic As New Dictionary Public DataPointDic As New Dictionary Public HistoricalPricesDic As New Dictionary Public HistoricalDataDic As New Dictionary @@ -13,6 +14,9 @@ Public StandardizedTagsDic As New Dictionary Public ReportedFundamentalsDic As New Dictionary Public ReportedFinancialsDic As New Dictionary Public ReportedTagsDic As New Dictionary +Public BankFundamentalsDic As New Dictionary +Public BankFinancialsDic As New Dictionary +Public BankTagsDic As New Dictionary Private CompanySuccessDic As New Dictionary Public DataPointRequestedTags As New Dictionary @@ -25,9 +29,10 @@ Private UpdatePrompt As Boolean Private APICallsAtLimit As Boolean Public Const BaseUrl = "https://www.intrinio.com/api" -Public Const Intrinio_Addin_Version = "2.3.2" +Public Const Intrinio_Addin_Version = "2.4.1" Public Sub IntrinioInitialize() + Dim File_Num As Long Dim sInFolder As String, sInFile As String Dim i As Integer @@ -55,6 +60,9 @@ Public Sub IntrinioInitialize() Call DescribeIntrinioReportedFundamentals Call DescribeIntrinioReportedTags Call DescribeIntrinioReportedFinancials + Call DescribeIntrinioBankFundamentals + Call DescribeIntrinioBankTags + Call DescribeIntrinioBankFinancials Call IntrinioRibbon #End If @@ -193,7 +201,7 @@ Private Function IntrinioCompanies(ticker As String, Item As String) Dim Request As New WebRequest Request.Resource = "companies/verify" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Request.AddQuerystringParam "ticker", ticker Dim Response As WebResponse @@ -274,7 +282,7 @@ Private Function IntrinioSecurities(ticker As String, Item As String) Dim Request As New WebRequest Request.Resource = "securities/verify" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Request.AddQuerystringParam "ticker", ticker Dim Response As WebResponse @@ -328,6 +336,85 @@ ErrorHandler: IntrinioSecurities = "" End Function + +Private Function IntrinioBanks(identifier As String, Item As String) + On Error GoTo ErrorHandler + + If identifier <> "" And LoginFailure = False And APICallsAtLimit = False Then + If BankDic.Exists(identifier) = False Then + Dim IntrinioClient As New WebClient + IntrinioClient.BaseUrl = BaseUrl + If iCredentials.Exists("username") = False Or iCredentials.Exists("password") = False Or iCredentials("username") = Empty Or iCredentials("password") = Empty Then + Call IntrinioInitialize + End If + + Dim inUsername As String + Dim inPassword As String + inUsername = iCredentials("username") + inPassword = iCredentials("password") + Dim Auth As New HttpBasicAuthenticator + Auth.Setup _ + Username:=inUsername, _ + Password:=inPassword + Set IntrinioClient.Authenticator = Auth + + Dim Request As New WebRequest + Request.Resource = "banks/verify" + Request.Method = HttpGet + Request.Format = JSON + Request.AddQuerystringParam "identifier", identifier + + Dim Response As WebResponse + Set Response = IntrinioClient.Execute(Request) + + If Response.StatusCode = ok Then + If Response.Data Is Nothing Then + IntrinioBanks = "" + Else + BankDic.Add Response.Data("identifier"), Response.Data + If IsNull(BankDic(identifier)(Item)) Then + IntrinioBanks = "" + Else + IntrinioBanks = BankDic(identifier)(Item) + End If + End If + ElseIf Response.StatusCode = 403 Then + APICallsAtLimit = True + IntrinioBanks = "Plan Limit Reached" + Else + IntrinioBanks = "" + End If + + ElseIf BankDic.Exists(identifier) = True Then + If IsNull(BankDic(identifier)(Item)) Then + IntrinioBanks = "" + Else + IntrinioBanks = BankDic(identifier)(Item) + End If + End If + Else + If APICallsAtLimit = True Then + If BankDic.Exists(identifier) = True Then + If IsNull(BankDic(identifier)(Item)) Then + IntrinioBanks = "Plan Limit Reached" + Else + IntrinioBanks = BankDic(identifier)(Item) + End If + Else + IntrinioBanks = BankDic(identifier)(Item) + End If + ElseIf LoginFailure = True Then + IntrinioBanks = "Invalid API Keys" + Else + IntrinioBanks = "" + End If + End If +ExitHere: + Exit Function +ErrorHandler: + IntrinioBanks = "" +End Function + Sub DescribeIntrinioDataPoint() Dim FuncName As String Dim FuncDesc As String @@ -389,8 +476,15 @@ Attribute IntrinioDataPoint.VB_ProcData.VB_Invoke_Func = " \n19" CompanySuccessDic.Add identifier, False coFailure = CompanySuccessDic(identifier) Else - CompanySuccessDic.Add identifier, True - coFailure = CompanySuccessDic(identifier) + api_ticker = IntrinioBanks(identifier, "identifier") + If api_ticker = identifier Then + CompanySuccessDic.Add identifier, False + coFailure = CompanySuccessDic(identifier) + Else + CompanySuccessDic.Add identifier, True + coFailure = CompanySuccessDic(identifier) + End If + End If End If @@ -471,7 +565,7 @@ Attribute IntrinioDataPoint.VB_ProcData.VB_Invoke_Func = " \n19" Dim Request As New WebRequest Request.Resource = "data_point" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Request.AddQuerystringParam "identifier", identifier Request.AddQuerystringParam "item", tags @@ -794,7 +888,7 @@ Attribute IntrinioHistoricalPrices.VB_ProcData.VB_Invoke_Func = " \n19" Dim Request As New WebRequest Request.Resource = "prices" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Request.AddQuerystringParam "ticker", ticker If start_date <> "" Then Request.AddQuerystringParam "start_date", start_date @@ -954,7 +1048,7 @@ Attribute IntrinioHistoricalData.VB_ProcData.VB_Invoke_Func = " \n19" Dim Request As New WebRequest Request.Resource = "historical_data" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Request.AddQuerystringParam "ticker", ticker Request.AddQuerystringParam "item", Item If start_date <> "" Then @@ -1120,7 +1214,7 @@ Attribute IntrinioNews.VB_ProcData.VB_Invoke_Func = " \n19" Dim Request As New WebRequest Request.Resource = "news" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Request.AddQuerystringParam "ticker", ticker Dim Response As WebResponse @@ -1280,7 +1374,7 @@ Attribute IntrinioStandardizedFundamentals.VB_ProcData.VB_Invoke_Func = " \n19" Dim Request As New WebRequest Request.Resource = "fundamentals/standardized" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Request.AddQuerystringParam "ticker", ticker Request.AddQuerystringParam "statement", statement Request.AddQuerystringParam "type", period_type @@ -1433,7 +1527,7 @@ Attribute IntrinioStandardizedTags.VB_ProcData.VB_Invoke_Func = " \n19" Dim Request As New WebRequest Request.Resource = "tags/standardized" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Request.AddQuerystringParam "ticker", ticker Request.AddQuerystringParam "statement", statement @@ -1625,7 +1719,7 @@ Attribute IntrinioStandardizedFinancials.VB_ProcData.VB_Invoke_Func = " \n19" Do Until is_last_page = True Request.Resource = "financials/standardized" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Request.AddQuerystringParam "ticker", ticker Request.AddQuerystringParam "statement", statement Request.AddQuerystringParam "fiscal_year", fiscal_year @@ -1855,7 +1949,7 @@ Attribute IntrinioReportedFundamentals.VB_ProcData.VB_Invoke_Func = " \n19" Dim Request As New WebRequest Request.Resource = "fundamentals/reported" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Request.AddQuerystringParam "ticker", ticker Request.AddQuerystringParam "statement", statement Request.AddQuerystringParam "type", period_type @@ -1995,7 +2089,7 @@ Attribute IntrinioReportedTags.VB_ProcData.VB_Invoke_Func = " \n19" Dim Request As New WebRequest Request.Resource = "tags/reported" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Request.AddQuerystringParam "ticker", ticker Request.AddQuerystringParam "statement", statement Request.AddQuerystringParam "fiscal_year", fiscal_year @@ -2174,7 +2268,7 @@ Attribute IntrinioReportedFinancials.VB_ProcData.VB_Invoke_Func = " \n19" Dim Request As New WebRequest Request.Resource = "financials/reported" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Request.AddQuerystringParam "ticker", ticker Request.AddQuerystringParam "statement", statement Request.AddQuerystringParam "fiscal_year", fiscal_year @@ -2263,6 +2357,496 @@ ErrorHandler: Resume Next End Function +Sub DescribeIntrinioBankFundamentals() + Dim FuncName As String + Dim FuncDesc As String + Dim Category As String + Dim ArgDesc(1 To 5) As String + + FuncName = "IntrinioBankFundamentals" + FuncDesc = "Returns a banks financial statement fundamental based on a period type and sequence number selected." + Category = "Intrinio" + ArgDesc(1) = "The company's identifier (i.e. ticker symbol 'JPM' or RSSD ID '361354')" + ArgDesc(2) = "The financial statement selected ('RI')" + ArgDesc(3) = "The period type ('FY','QTR','YTD')" + ArgDesc(4) = "The sequence order of the fundamental from newest to oldest (0..last available)" + ArgDesc(5) = "The item you are selecting (i.e. 'fiscal_year' returns 2014, 'fiscal_period' returns 'FY', 'end_date' returns the last date of the period, 'start_date' returns the beginning of the period)" + + Application.MacroOptions Macro:=FuncName, _ + Description:=FuncDesc, _ + Category:=Category, _ + ArgumentDescriptions:=ArgDesc +End Sub + + +Public Function IntrinioBankFundamentals(identifier As String, _ + statement As String, _ + period_type As String, _ + sequence As Integer, _ + Item As String) +Attribute IntrinioBankFundamentals.VB_Description = "Returns a banks financial statement fundamental based on a period type and sequence number selected." +Attribute IntrinioBankFundamentals.VB_ProcData.VB_Invoke_Func = " \n19" + Dim Key As String + Dim api_identifier As String + Dim coFailure As Boolean + + On Error GoTo ErrorHandler + + If identifier <> "" And LoginFailure = False Then + If CompanySuccessDic.Exists(identifier) = False Then + api_identifier = IntrinioBanks(identifier, "identifier") + If api_identifier = identifier Then + CompanySuccessDic.Add identifier, False + coFailure = CompanySuccessDic(identifier) + Else + CompanySuccessDic.Add identifier, True + coFailure = CompanySuccessDic(identifier) + End If + Else + If APICallsAtLimit = False Then + coFailure = CompanySuccessDic(identifier) + Else + coFailure = False + End If + End If + End If + + If identifier <> "" And statement <> "" And period_type <> "" And LoginFailure = False And APICallsAtLimit = False And coFailure = False Then + Key = identifier & "_" & statement & "_" & period_type + + If BankFundamentalsDic.Exists(Key) = False Then + Dim IntrinioClient As New WebClient + IntrinioClient.BaseUrl = BaseUrl + If iCredentials.Exists("username") = False Or iCredentials.Exists("password") = False Or iCredentials("username") = Empty Or iCredentials("password") = Empty Then + Call IntrinioInitialize + End If + + Dim inUsername As String + Dim inPassword As String + inUsername = iCredentials("username") + inPassword = iCredentials("password") + Dim Auth As New HttpBasicAuthenticator + Auth.Setup _ + Username:=inUsername, _ + Password:=inPassword + Set IntrinioClient.Authenticator = Auth + + Dim Request As New WebRequest + Request.Resource = "fundamentals/banks" + Request.Method = HttpGet + Request.Format = JSON + Request.AddQuerystringParam "identifier", identifier + Request.AddQuerystringParam "statement", statement + Request.AddQuerystringParam "type", period_type + + Dim Response As WebResponse + Set Response = IntrinioClient.Execute(Request) + + If Response.StatusCode = ok Then + BankFundamentalsDic.Add Key, Response.Data("data") + IntrinioBankFundamentals = BankFundamentalsDic(Key)(sequence + 1)(Item) + ElseIf Response.StatusCode = 403 Then + APICallsAtLimit = True + IntrinioBankFundamentals = "Plan Limit Reached" + Else + IntrinioBankFundamentals = "" + End If + ElseIf BankFundamentalsDic.Exists(Key) = True Then + IntrinioBankFundamentals = BankFundamentalsDic(Key)(sequence + 1)(Item) + End If + Else + If APICallsAtLimit = True Then + Key = identifier & "_" & statement & "_" & period_type + If BankFundamentalsDic.Exists(Key) = True Then + IntrinioBankFundamentals = BankFundamentalsDic(Key)(sequence + 1)(Item) + Else + IntrinioBankFundamentals = "Plan Limit Reached" + End If + ElseIf LoginFailure = True Then + IntrinioBankFundamentals = "Invalid API Keys" + ElseIf coFailure = True Then + IntrinioBankFundamentals = "Invalid identifier Symbol" + Else + IntrinioBankFundamentals = "" + End If + End If +ExitHere: + Exit Function +ErrorHandler: + IntrinioBankFundamentals = "" +End Function + + +Sub DescribeIntrinioBankTags() + Dim FuncName As String + Dim FuncDesc As String + Dim Category As String + Dim ArgDesc(1 To 4) As String + + FuncName = "IntrinioBankTags" + FuncDesc = "Returns a bank tag for a selected bank and financial statement, by selecting a specific tag based on the sequence number selected." + Category = "Intrinio" + ArgDesc(1) = "The banks's Identifier (i.e. ticker symbol 'JPM' or RSSD ID '361354')" + ArgDesc(2) = "The financial statement selected" + ArgDesc(3) = "The sequence order of the tag from first to last (0..last available)" + ArgDesc(4) = "The item you are selecting (i.e. 'name' returns the human readable name, 'tag' returns the Bank tag, 'balance' returns debit or credit, 'unit' returns the units for the tag)" + + Application.MacroOptions Macro:=FuncName, _ + Description:=FuncDesc, _ + Category:=Category, _ + ArgumentDescriptions:=ArgDesc +End Sub + + +Public Function IntrinioBankTags(identifier As String, _ + statement As String, _ + sequence As Integer, _ + Item As String) +Attribute IntrinioBankTags.VB_Description = "Returns a bank tag for a selected bank and financial statement, by selecting a specific tag based on the sequence number selected." +Attribute IntrinioBankTags.VB_ProcData.VB_Invoke_Func = " \n19" + Dim Key As String + Dim api_identifier As String + Dim coFailure As Boolean + + On Error GoTo ErrorHandler + + identifier = VBA.UCase(identifier) + + If identifier <> "" And LoginFailure = False Then + If CompanySuccessDic.Exists(identifier) = False Then + api_identifier = IntrinioBanks(identifier, "identifier") + If api_identifier = identifier Then + CompanySuccessDic.Add identifier, False + coFailure = CompanySuccessDic(identifier) + Else + CompanySuccessDic.Add identifier, True + coFailure = CompanySuccessDic(identifier) + End If + Else + If APICallsAtLimit = False Then + coFailure = CompanySuccessDic(identifier) + Else + coFailure = False + End If + End If + End If + + If identifier <> "" And statement <> "" And LoginFailure = False And APICallsAtLimit = False And coFailure = False Then + Key = identifier & "_" & statement + + If BankTagsDic.Exists(Key) = False Then + Dim IntrinioClient As New WebClient + IntrinioClient.BaseUrl = BaseUrl + If iCredentials.Exists("username") = False Or iCredentials.Exists("password") = False Or iCredentials("username") = Empty Or iCredentials("password") = Empty Then + Call IntrinioInitialize + End If + + Dim inUsername As String + Dim inPassword As String + inUsername = iCredentials("username") + inPassword = iCredentials("password") + Dim Auth As New HttpBasicAuthenticator + Auth.Setup _ + Username:=inUsername, _ + Password:=inPassword + Set IntrinioClient.Authenticator = Auth + + Dim Request As New WebRequest + Request.Resource = "tags/banks" + Request.Method = HttpGet + Request.Format = JSON + Request.AddQuerystringParam "identifier", identifier + Request.AddQuerystringParam "statement", statement + + Dim Response As WebResponse + Set Response = IntrinioClient.Execute(Request) + + If Response.StatusCode = ok Then + BankTagsDic.Add Key, Response.Data("data") + IntrinioBankTags = BankTagsDic(Key)(sequence + 1)(Item) + ElseIf Response.StatusCode = 403 Then + APICallsAtLimit = True + IntrinioBankTags = "Plan Limit Reached" + Else + IntrinioBankTags = "" + End If + ElseIf BankTagsDic.Exists(Key) = True Then + IntrinioBankTags = BankTagsDic(Key)(sequence + 1)(Item) + End If + Else + If APICallsAtLimit = True Then + Key = identifier & "_" & statement + + If BankTagsDic.Exists(Key) = True Then + IntrinioBankTags = BankTagsDic(Key)(sequence + 1)(Item) + Else + IntrinioBankTags = "Plan Limit Reached" + End If + + ElseIf LoginFailure = True Then + IntrinioBankTags = "Invalid API Keys" + ElseIf coFailure = True Then + IntrinioBankTags = "Invalid identifier Symbol" + Else + IntrinioBankTags = "" + End If + End If +ExitHere: + Exit Function +ErrorHandler: + IntrinioBankTags = "" +End Function + + +Sub DescribeIntrinioBankFinancials() + Dim FuncName As String + Dim FuncDesc As String + Dim Category As String + Dim ArgDesc(1 To 6) As String + + FuncName = "IntrinioBankFinancials" + FuncDesc = "Returns historical financial statement data point for a bank, based on the tag, fiscal year and fiscal period." + Category = "Intrinio" + ArgDesc(1) = "The company's identifier (i.e. ticker symbol 'JPM' or RSSD ID '749635')" + ArgDesc(2) = "The financial statement selected" + ArgDesc(3) = "The selected fiscal year for the chosen statement (i.e. 2014, 2013, 2012, etc.)" + ArgDesc(4) = "The selected fiscal period for the chosen statement ('FY', 'Q1', 'Q2', 'Q3', 'Q2YTD', 'Q3YTD')" + ArgDesc(5) = "The selected tag contained within the statement" + ArgDesc(6) = "(Optional) Round the value (blank or 'A' for actuals, 'K' for thousands, 'M' for millions, 'B' for billions)" + + Application.MacroOptions Macro:=FuncName, _ + Description:=FuncDesc, _ + Category:=Category, _ + ArgumentDescriptions:=ArgDesc +End Sub + + +Public Function IntrinioBankFinancials(identifier As String, _ + statement As String, _ + fiscal_year As Integer, _ + fiscal_period As String, _ + tag As String, _ + Optional rounding As String = "A") +Attribute IntrinioBankFinancials.VB_Description = "Returns historical financial statement data point for a bank, based on the tag, fiscal year and fiscal period." +Attribute IntrinioBankFinancials.VB_ProcData.VB_Invoke_Func = " \n19" + + Dim Key As String + Dim eKey As String + Dim nKey As String + Dim X As Variant + Dim rTag As String + Dim rValue As Double + Dim sValue As String + Dim Value As Double + Dim Rounder As Double + Dim api_identifier As String + Dim coFailure As Boolean + Dim fundamental_sequence As Integer + Dim fundamental_type As String + + On Error GoTo ErrorHandler + + identifier = VBA.UCase(identifier) + + If identifier <> "" And LoginFailure = False Then + If CompanySuccessDic.Exists(identifier) = False Then + api_identifier = IntrinioBanks(identifier, "identifier") + If api_identifier = identifier Then + CompanySuccessDic.Add identifier, False + coFailure = CompanySuccessDic(identifier) + Else + api_identifier = IntrinioSecurities(identifier, "identifier") + If api_identifier = identifier Then + CompanySuccessDic.Add identifier, False + coFailure = CompanySuccessDic(identifier) + Else + CompanySuccessDic.Add identifier, True + coFailure = CompanySuccessDic(identifier) + End If + End If + Else + If APICallsAtLimit = False Then + coFailure = CompanySuccessDic(identifier) + Else + coFailure = False + End If + End If + End If + + + If identifier <> "" And statement <> "" And LoginFailure = False And APICallsAtLimit = False And coFailure = False Then + If fiscal_year < 1900 Then + fundamental_type = fiscal_period + fundamental_sequence = fiscal_year + fiscal_year = IntrinioBankFundamentals(identifier, statement, fundamental_type, fundamental_sequence, "fiscal_year") + fiscal_period = IntrinioBankFundamentals(identifier, statement, fundamental_type, fundamental_sequence, "fiscal_period") + End If + End If + + If identifier <> "" And statement <> "" And fiscal_year <> 0 And fiscal_period <> "" And LoginFailure = False And APICallsAtLimit = False And coFailure = False Then + + + Key = identifier & "_" & statement & "_" & fiscal_year & "_" & fiscal_period + + If BankFinancialsDic.Exists(Key) = False Then + Dim IntrinioClient As New WebClient + IntrinioClient.BaseUrl = BaseUrl + If iCredentials.Exists("username") = False Or iCredentials.Exists("password") = False Or iCredentials("username") = Empty Or iCredentials("password") = Empty Then + Call IntrinioInitialize + End If + + Dim inUsername As String + Dim inPassword As String + inUsername = iCredentials("username") + inPassword = iCredentials("password") + Dim Auth As New HttpBasicAuthenticator + Auth.Setup _ + Username:=inUsername, _ + Password:=inPassword + Set IntrinioClient.Authenticator = Auth + + Dim Request As New WebRequest + Dim last_page As Integer + Dim is_last_page As Boolean + Dim page As Integer + Dim Response As WebResponse + + page = 1 + + Do Until is_last_page = True + Request.Resource = "financials/banks" + Request.Method = HttpGet + Request.Format = JSON + Request.AddQuerystringParam "identifier", identifier + Request.AddQuerystringParam "statement", statement + Request.AddQuerystringParam "fiscal_year", fiscal_year + Request.AddQuerystringParam "fiscal_period", fiscal_period + + Set Response = IntrinioClient.Execute(Request) + + If Response.StatusCode = ok Then + If Response.Content <> "" Then + last_page = Response.Data("total_pages") + If last_page > 0 Then + If last_page = page Then + is_last_page = True + Else + is_last_page = False + page = page + 1 + End If + + If BankFinancialsDic.Exists(Key) = False Then + BankFinancialsDic.Add Key, Response.Data("data") + ElseIf BankFinancialsDic.Exists(Key) = True Then + BankFinancialsDic.Remove (Key) + BankFinancialsDic.Add Key, Response.Data("data") + End If + + For Each X In BankFinancialsDic(Key) + rTag = X("tag") + sValue = X("value") + nKey = identifier & "_" & statement & "_" & fiscal_year & "_" & fiscal_period & "_" & rTag + If BankFinancialsDic.Exists(nKey) = True Then + BankFinancialsDic.Remove (nKey) + End If + BankFinancialsDic.Add nKey, sValue + Next + Else + is_last_page = True + If BankFinancialsDic.Exists(Key) = False Then + BankFinancialsDic.Add Key, Response.Data("data") + ElseIf BankFinancialsDic.Exists(Key) = True Then + BankFinancialsDic.Remove (Key) + BankFinancialsDic.Add Key, Response.Data("data") + End If + End If + Else + is_last_page = True + If BankFinancialsDic.Exists(Key) = False Then + BankFinancialsDic.Add Key, Empty + ElseIf BankFinancialsDic.Exists(Key) = True Then + BankFinancialsDic.Remove (Key) + BankFinancialsDic.Add Key, Empty + End If + End If + Else + is_last_page = True + If Response.StatusCode = 403 Then + APICallsAtLimit = True + IntrinioBankFinancials = "Plan Limit Reached" + Else + IntrinioBankFinancials = "" + End If + End If + Loop + + eKey = identifier & "_" & statement & "_" & fiscal_year & "_" & fiscal_period & "_" & tag + + If BankFinancialsDic.Exists(Key) = True Then + + If BankFinancialsDic(Key) Is Not Empty Then + + If IsNumeric(BankFinancialsDic(eKey)) = True Then + Value = BankFinancialsDic(eKey) + If rounding = "K" Then + Rounder = 1000 + ElseIf rounding = "M" Then + Rounder = 1000000 + ElseIf rounding = "B" Then + Rounder = 1000000000 + Else + Rounder = 1 + End If + + IntrinioBankFinancials = Value / Rounder + Else + IntrinioBankFinancials = BankFinancialsDic(eKey) + End If + Else + IntrinioBankFinancials = "" + End If + Else + IntrinioBankFinancials = "" + End If + ElseIf BankFinancialsDic.Exists(Key) = True Then + eKey = identifier & "_" & statement & "_" & fiscal_year & "_" & fiscal_period & "_" & tag + + If IsNumeric(BankFinancialsDic(eKey)) = True Then + Value = BankFinancialsDic(eKey) + + If rounding = "K" Then + Rounder = 1000 + ElseIf rounding = "M" Then + Rounder = 1000000 + ElseIf rounding = "B" Then + Rounder = 1000000000 + Else + Rounder = 1 + End If + + IntrinioBankFinancials = Value / Rounder + Else + IntrinioBankFinancials = BankFinancialsDic(eKey) + End If + End If + Else + If APICallsAtLimit = True Then + IntrinioBankFinancials = "Plan Limit Reached" + ElseIf LoginFailure = True Then + IntrinioBankFinancials = "Invalid API Keys" + ElseIf coFailure = True Then + IntrinioBankFinancials = "Invalid Identifier" + Else + IntrinioBankFinancials = "" + End If + End If +ExitHere: + Exit Function +ErrorHandler: + IntrinioBankFinancials = "" + Resume Next +End Function + Private Function IntrinioAddinVersion(Item As String) Dim IntrinioClient As New WebClient IntrinioClient.BaseUrl = BaseUrl @@ -2284,7 +2868,7 @@ Private Function IntrinioAddinVersion(Item As String) Dim Request As New WebRequest Request.Resource = "excel" Request.Method = HttpGet - Request.Format = Json + Request.Format = JSON Dim Response As WebResponse Set Response = IntrinioClient.Execute(Request) @@ -2541,6 +3125,9 @@ Public Sub IntrinioRefresh() ReportedFundamentalsDic.RemoveAll ReportedFinancialsDic.RemoveAll ReportedTagsDic.RemoveAll + BankFundamentalsDic.RemoveAll + BankFinancialsDic.RemoveAll + BankTagsDic.RemoveAll APICallsAtLimit = False LoginFailure = False diff --git a/src/frmIntrinioAPIKeys.frm b/src/frmIntrinioAPIKeys.frm index c3b30da..b4bf49c 100644 --- a/src/frmIntrinioAPIKeys.frm +++ b/src/frmIntrinioAPIKeys.frm @@ -1,7 +1,7 @@ VERSION 5.00 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmIntrinioAPIKeys Caption = "Intrinio API Keys" - ClientHeight = 2265 + ClientHeight = 2100 ClientLeft = 42 ClientTop = -1904 ClientWidth = 8736.001 @@ -50,6 +50,13 @@ Private Sub cmdUpdate_Click() Unload Me End Sub + +Private Sub lblAPIKeys_Click() + Dim Url As String + Url = "https://home.intrinio.com/getting-started-excel-step-3/" + ActiveWorkbook.FollowHyperlink Url +End Sub + Private Sub UserForm_Initialize() Dim File_Num As Long Dim sInFolder As String, sInFile As String @@ -114,55 +121,56 @@ Private Sub UserForm_Initialize() End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) - - If CloseMode = vbFormControlMenu Then - Dim File_Num As Long - Dim sOutFolder As String, sOutFile As String - Dim IntrinioUsername As String - Dim IntrinioPassword As String - Dim sInFolder As String, sInFile As String, textline As String - Dim i As Integer, lLength As Integer, bString As Integer - - sInFolder = ThisWorkbook.path - - sInFile = "Intrinio_API_Keys" - - File_Num = FreeFile - Open sInFolder & Application.PathSeparator & VBA.Trim(sInFile) & ".txt" For Input As #File_Num - i = 1 - Do Until EOF(1) - Line Input #1, textline - lLength = Len(textline) - bString = InStr(textline, ":") - IntrinioUsername = VBA.Left(textline, bString - 1) - IntrinioPassword = VBA.Right(textline, lLength - bString) - Loop - - Close #File_Num - - If IntrinioUsername <> "" Or IntrinioPassword <> "" Then - Unload Me - Else - IntrinioUsername = "" - IntrinioPassword = "" + #If Win32 Or Win64 Then + If CloseMode = vbFormControlMenu Then + Dim File_Num As Long + Dim sOutFolder As String, sOutFile As String + Dim IntrinioUsername As String + Dim IntrinioPassword As String + Dim sInFolder As String, sInFile As String, textline As String + Dim i As Integer, lLength As Integer, bString As Integer - On Error Resume Next - sOutFolder = ThisWorkbook.path - - On Error GoTo 0 + sInFolder = ThisWorkbook.path + + sInFile = "Intrinio_API_Keys" + File_Num = FreeFile - With ActiveSheet - 'Specify the output filename without destroying the original value - sOutFile = "Intrinio_API_Keys" - 'Specify the correct output folder and the output file name - Open sOutFolder & Application.PathSeparator & VBA.Trim(sOutFile) & ".txt" For Output As #File_Num - Print #1, IntrinioUsername & ":" & IntrinioPassword - Close #File_Num - End With - Call IntrinioInitialize - Unload Me + Open sInFolder & Application.PathSeparator & VBA.Trim(sInFile) & ".txt" For Input As #File_Num + i = 1 + Do Until EOF(1) + Line Input #1, textline + lLength = Len(textline) + bString = InStr(textline, ":") + IntrinioUsername = VBA.Left(textline, bString - 1) + IntrinioPassword = VBA.Right(textline, lLength - bString) + Loop + + Close #File_Num + + If IntrinioUsername <> "" Or IntrinioPassword <> "" Then + Unload Me + Else + IntrinioUsername = "" + IntrinioPassword = "" + + On Error Resume Next + sOutFolder = ThisWorkbook.path + + On Error GoTo 0 + File_Num = FreeFile + With ActiveSheet + 'Specify the output filename without destroying the original value + sOutFile = "Intrinio_API_Keys" + 'Specify the correct output folder and the output file name + Open sOutFolder & Application.PathSeparator & VBA.Trim(sOutFile) & ".txt" For Output As #File_Num + Print #1, IntrinioUsername & ":" & IntrinioPassword + Close #File_Num + End With + Call IntrinioInitialize + Unload Me + End If End If - End If + #End If End Sub Private Sub UserForm_Terminate() diff --git a/src/frmIntrinioAPIKeys.frx b/src/frmIntrinioAPIKeys.frx index 1dc767d..dbe7b11 100644 Binary files a/src/frmIntrinioAPIKeys.frx and b/src/frmIntrinioAPIKeys.frx differ diff --git a/templates/FDIC Call Reports/BankCallReportForm31.xlsm b/templates/FDIC Call Reports/BankCallReportForm31.xlsm new file mode 100644 index 0000000..46bddf9 Binary files /dev/null and b/templates/FDIC Call Reports/BankCallReportForm31.xlsm differ diff --git a/templates/FDIC Call Reports/BankCallReportForm41.xlsm b/templates/FDIC Call Reports/BankCallReportForm41.xlsm new file mode 100644 index 0000000..75dcc05 Binary files /dev/null and b/templates/FDIC Call Reports/BankCallReportForm41.xlsm differ diff --git a/templates/Financials/IntrinioFinancialData-Financials.xlsm b/templates/Financials/IntrinioFinancialData-Financials.xlsm index ec3b75d..54ff99f 100644 Binary files a/templates/Financials/IntrinioFinancialData-Financials.xlsm and b/templates/Financials/IntrinioFinancialData-Financials.xlsm differ diff --git a/templates/Industrials/IntrinioComps.xlsm b/templates/Industrials/IntrinioComps.xlsm index 8410024..194517f 100644 Binary files a/templates/Industrials/IntrinioComps.xlsm and b/templates/Industrials/IntrinioComps.xlsm differ diff --git a/templates/Industrials/IntrinioDCF.xlsm b/templates/Industrials/IntrinioDCF.xlsm index 9ab5d91..0192874 100644 Binary files a/templates/Industrials/IntrinioDCF.xlsm and b/templates/Industrials/IntrinioDCF.xlsm differ diff --git a/templates/Industrials/IntrinioFinancialData-Industrials.xlsm b/templates/Industrials/IntrinioFinancialData-Industrials.xlsm index 830ae6f..60190e3 100644 Binary files a/templates/Industrials/IntrinioFinancialData-Industrials.xlsm and b/templates/Industrials/IntrinioFinancialData-Industrials.xlsm differ diff --git a/templates/IntrinioSecurityPrices.xlsm b/templates/IntrinioSecurityPrices.xlsm index 6774491..ffba964 100644 Binary files a/templates/IntrinioSecurityPrices.xlsm and b/templates/IntrinioSecurityPrices.xlsm differ diff --git a/templates/OverviewReport.xlsm b/templates/OverviewReport.xlsm new file mode 100644 index 0000000..268a6b4 Binary files /dev/null and b/templates/OverviewReport.xlsm differ