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 ("List: | ") ts.WriteLine ("
---|
" & rs.AbsolutePosition + 1 & " | ") ts.WriteLine ("" & rs!EntityRegistrantName & " | ") ts.WriteLine ("
") ts.WriteLine (" |
")
ts.WriteLine (" ")
ts.WriteLine (" ")
ts.WriteLine ("
This work is licensed under a Creative Commons License.")
ts.WriteLine (" ")
ts.WriteLine (" ")
ts.WriteLine ("