Public m_AuthorizationToken As String Function RunLevel2PolicyTextBlocks() Dim rs As Recordset Set rs = CurrentDb().OpenRecordset("SELECT * FROM qryTEMPPolicyLevel WHERE ReportElementName = 'us-gaap:AdvertisingCostsPolicyTextBlock'") Do While Not rs.EOF Debug.Print rs.AbsolutePosition & " " & rs!ReportElementName GetPolicyTextBlockInfoFromSP500 rs!ReportElementName, rs!ReportElementName rs.MoveNext Loop MsgBox "Done!" ' End Function Private Function GetPolicyTextBlockInfoFromSP500(txtDisclosureName As String, txtTextBlock As String) Dim oHTTP As New MSXML2.XMLHTTP Dim oDocument As MSXML2.DOMDocument Dim strResponseReceived As String Dim strFullURL As String Dim txtToken As String txtToken = GetAuthorizationToken strFullURL = "https://secxbrl.xbrl.io/v1/_queries/public/api/components.jq?_method=POST&format=xml&fiscalYear=2013&fiscalPeriod=FY&reportElement=" & txtTextBlock & "&tag=SP500&token=" & GetAuthorizationToken Debug.Print strFullURL 'HTTP request 'MsgBox objHTTP.readyState oHTTP.Open "POST", strFullURL, False oHTTP.setRequestHeader "Content-Type", "application/xml" oHTTP.send strFullURL 'HTTP response strResponseReceived = oHTTP.responseText 'MsgBox strResponseReceived 'Debug.Print strResponseReceived 'Load XML received into XML parser Set oDocument = New MSXML2.DOMDocument oDocument.loadXML (strResponseReceived) 'Saves a copy of the response received oDocument.Save CurrentProject.Path & "\" & "DisclosuresReturned.xml" Dim oNodeList As MSXML2.IXMLDOMNodeList Dim oNode As MSXML2.IXMLDOMNode Set oNodeList = oDocument.selectNodes("//Archive[Components/Component/Category!='Statement']") 'MsgBox "Count of disclosures added: " & oNodeList.length Dim rs As Recordset Set rs = CurrentDb().OpenRecordset("SELECT * FROM Disclosure_Exemplars_TextBlocks'") For Each oNode In oNodeList DoEvents Debug.Print oNode.selectSingleNode("Components/Component/Disclosure").Text Debug.Print Mid(oNode.selectSingleNode("./CIK").Text, 24, 10) Debug.Print oNode.selectSingleNode("EntityRegistrantName").Text Debug.Print oNode.selectSingleNode("./@id").Text 'Debug.Print oNode.selectSingleNode("Components/Component/@id").Text Debug.Print oNode.selectSingleNode("Components/Component/NetworkIdentifier").Text Debug.Print oNode.selectSingleNode("Components/Component/NetworkLabel").Text Debug.Print oNode.selectSingleNode("Components/Component/Table").Text Debug.Print oNode.selectSingleNode("Components/Component/Category").Text Debug.Print oNode.selectSingleNode("Components/Component/SubCategory").Text Debug.Print "" rs.AddNew rs!DisclosureObjectName = txtDisclosureName rs!CIK = Mid(oNode.selectSingleNode("./CIK").Text, 24, 10) rs!EntityRegistrantName = oNode.selectSingleNode("EntityRegistrantName").Text rs!AccessionNumber = oNode.selectSingleNode("./@id").Text rs!NetworkName = oNode.selectSingleNode("Components/Component/NetworkIdentifier").Text rs!NetworkLabel = oNode.selectSingleNode("Components/Component/NetworkLabel").Text rs!TableName = oNode.selectSingleNode("Components/Component/Table").Text rs!Category = oNode.selectSingleNode("Components/Component/Category").Text rs!Subcategory = "TextBlock" rs!LastUpdated = Format(Now(), "yyyy-mm-dd") rs!Confidence = 90 rs!Likes = 1 rs!Dislikes = 0 rs!Rating = 3 rs!Flag = True rs.Update Next Set rs = Nothing Debug.Print "Total found: " & oNodeList.length Set oDocument = Nothing Set objHTTP = Nothing Set oNodeList = Nothing End Function Function GenerateHTMLFileForTextBlock() Dim rs As Recordset Set rs = CurrentDb().OpenRecordset("SELECT * FROM Disclosure_Exemplars_TextBlocks WHERE ID Between 138 AND 138") 'Set rs = CurrentDb().OpenRecordset("SELECT * FROM Disclosure_Exemplars_TextBlocks") Do While Not rs.EOF DoEvents Debug.Print rs.AbsolutePosition & " " & rs!DisclosureObjectName GetFactAndCreateHTMLFile rs!ID, rs!DisclosureObjectName, rs!CIK, rs!AccessionNumber, rs!NetworkName, GetAuthorizationToken rs.MoveNext Loop Debug.Print "Done!" ' End Function Private Function GetFactAndCreateHTMLFile(intID As Long, strDisclosure As String, strCIK As String, strAccessionNumber As String, strNetworkIdentifier As String, strToken As String) On Error GoTo ErrorHandler Dim oHTTP As New MSXML2.XMLHTTP Dim oDocument As MSXML2.DOMDocument Dim strResponseReceived As String Dim strFullURL As String 'strFullURL = "http://secxbrl.xbrl.io/v1/_queries/public/api/facts.jq?_method=POST&format=xml&concept=us-gaap:ScheduleOfAccountsNotesLoansAndFinancingReceivableTextBlock&fiacalPeriod=FY&fiscalYear=2013&cik=0001387467&token=809de35f-f74b-4b20-8393-8d9abc2f09dd" strFullURL = "http://secxbrl.xbrl.io/v1/_queries/public/api/facttable-for-component.jq?format=xml&_method=POST&aid=" & strAccessionNumber & "&networkIdentifier=" & strNetworkIdentifier & "&token=" & strToken Debug.Print strFullURL oHTTP.Open "POST", strFullURL, False oHTTP.setRequestHeader "Content-Type", "application/xml" oHTTP.send strFullURL strResponseReceived = oHTTP.responseText 'MsgBox strResponseReceived 'Debug.Print strResponseReceived 'Load XML received into XML parser Set oDocument = New MSXML2.DOMDocument oDocument.loadXML (strResponseReceived) 'Debug.Print oDocument.selectSingleNode("//Fact[Aspects/Aspect/Value='us-gaap:AdvertisingCostsPolicyTextBlock']/Value").Text Debug.Print oDocument.selectSingleNode("//Fact[Aspects/Aspect/Value='" & strDisclosure & "']/Value").Text ' Dim OutputFile As String OutputFile = "C:\Users\Charlie\Documents\CurrentVersions\UGT-2014\TextBlocks\" & intID & ".html" Dim fs As FileSystemObject Dim ts As TextStream Set fs = New FileSystemObject Set ts = fs.CreateTextFile(OutputFile) ts.WriteLine ("") ts.WriteLine ("") ts.WriteLine ("") ts.WriteLine (" ") ts.WriteLine (" Policy") ts.WriteLine (" ") ts.WriteLine ("") ts.WriteLine ("") ts.WriteLine ("

" & oDocument.selectSingleNode("//FactTable/@entityRegistrantName").Text & " | " & oDocument.selectSingleNode("//FactTable/@fiscalYear").Text & " | " & oDocument.selectSingleNode("//FactTable/@fiscalPeriod").Text & "

") ts.WriteLine (oDocument.selectSingleNode("//Fact[Aspects/Aspect/Value='" & strDisclosure & "']/Value").Text) ts.WriteLine ("") ts.WriteLine ("") Set oDocument = Nothing Set objHTTP = Nothing Set oNodeList = Nothing Set ts = Nothing Set fs = Nothing Exit Function ErrorHandler: Debug.Print Err.Number If Err.Number = 91 Then Debug.Print "NOT FOUND " & Err.Number & ": " & Err.Description Else Debug.Print "Error number " & Err.Number & ": " & Err.Description 'MsgBox "Wait" End If Resume Next End Function Private Function GenerateViewer_Contents() Dim OutputFile As String Dim fs As FileSystemObject Dim ts As TextStream Dim rs As Recordset Dim rsDetail As Recordset OutputFile = "C:\Users\Charlie\Documents\CurrentVersions\UGT-2014\TextBlocks\index_Contents.html" Set fs = New FileSystemObject Set ts = fs.CreateTextFile(OutputFile) ts.WriteLine ("") ts.WriteLine ("") ts.WriteLine ("") ts.WriteLine (" Index") ts.WriteLine (" ") 'Color theme '003EBA 5D7CBA 8B9BBA 29447B 14223D 455D8B 7986A1 'FF9000 FFC77F FFE3BF A97838 543C1C BF955F DDC5A6 ts.WriteLine (" ") ts.WriteLine ("") ts.WriteLine ("") ts.WriteLine ("

Advertising cost policy
(us-gaap:AdvertisingCostsPolicyTextBlock)

") ts.WriteLine ("
") ts.WriteLine (" ") ts.WriteLine (" ") ts.WriteLine (" ") ts.WriteLine (" ") ts.WriteLine ("
List:
") ' ts.WriteLine ("

*

") ' ts.WriteLine ("
") ts.WriteLine (" ") 'Disclosure Object and template Set rs = CurrentDb().OpenRecordset("SELECT * FROM Disclosure_Exemplars_TextBlocks ORDER BY EntityRegistrantName") Dim strColor As String strColor = "#FFFFCC" '"#FFFFCC" Do While Not rs.EOF 'Debug.Print rs.AbsolutePosition + 1 If rs.AbsolutePosition Mod 2 <> 0 Then strColor = "#FFFFCC" '"#FFFFCC" Else strColor = "#ccffcc" '"#ccffcc" '"White" End If ts.WriteLine (" ") ts.WriteLine (" ") ts.WriteLine (" ") ts.WriteLine (" ") rs.MoveNext Loop ts.WriteLine (" ") ts.WriteLine (" ") ts.WriteLine (" ") ts.WriteLine ("
" & rs.AbsolutePosition + 1 & "" & rs!EntityRegistrantName & "

*

") ts.WriteLine ("
") ts.WriteLine ("

*

") ts.WriteLine ("

") ts.WriteLine (" ") ts.WriteLine (" Creative Commons License") ts.WriteLine ("
This work is licensed under a Creative Commons License.") ts.WriteLine (" ") ts.WriteLine (" ") ts.WriteLine ("

") ts.WriteLine (" ") ts.WriteLine ("") 'Debug.Print "Done!" Set rs = Nothing End Function Private Function GetAuthorizationToken() As String 'MsgBox Len(m_AuthorizationToken) If Len(m_AuthorizationToken) > 5 Then 'MsgBox "Authorization exists, using existing token" GetAuthorizationToken = m_AuthorizationToken Exit Function Else 'Continue End If Dim strUserName As String Dim strPassword As String strUserName = "{{your username goes here}}" strPassword = "{{your password goes here}}" Dim oHTTP As New MSXML2.XMLHTTP Dim oDocument As MSXML2.DOMDocument Dim strResponseReceived As String Dim strFullURL As String strFullURL = "http://secxbrl.xbrl.io/v1/_queries/public/session/login.jq?_method=POST&format=xml&email=" & strUserName & "&password=" & strPassword Debug.Print strFullURL 'HTTP request 'MsgBox objHTTP.readyState oHTTP.Open "POST", strFullURL, False 'oHTTP.setRequestHeader "Authorization", "Basic " & Base64Encode(strUserName & ":" & strPassword) oHTTP.setRequestHeader "Content-Type", "application/xml" oHTTP.send strFullURL 'HTTP response strResponseReceived = oHTTP.responseText 'MsgBox strResponseReceived 'Debug.Print strResponseReceived 'Load XML received into XML parser Set oDocument = New MSXML2.DOMDocument oDocument.loadXML (strResponseReceived) 'Saves a copy of the response received 'MsgBox oDocument.XML m_AuthorizationToken = oDocument.selectSingleNode("/result/token").Text GetAuthorizationToken = oDocument.selectSingleNode("/result/token").Text 'MsgBox "Obtained token: " & GetAuthorizationToken Set oDocument = Nothing Set objHTTP = Nothing Set oNodeList = Nothing End Function