XBRL RSS Feed Reader (kostenlos)
Mit dem kostenfrei zur Verfügung gestellten Excel-Tool können Sie in wenigen Schritten die über die US-Börsenaufsicht SEC im XBRL-Format veröffentlichten Finanzberichte für eigene Analysezwecke herunterladen. Was ist der Vorteil? Da es sich bei XBRL-Berichten um ein strukturiertes Format handelt, sind automatisierte Auswertungen dieser Finanzdaten nahezu unbegrenzt möglich.
Die Verwendung ist denkbar einfach: nach Installation des Excel-Tools folgen Sie den Anweisungen in der Anleitung. Das heißt, Sie laden zunächst über den in der Anleitung aufgeführten Link zum SEC EDGAR Server eine Datei herunter, in der monatsweise eine Übersichtsliste mit allen auf dem Server verfügbaren XBRL-Dokumenten aufgeführt ist. Das Excel-Tool hilft Ihnen dabei, die aus dieser Auflistung gewünschten XBRL-Filings vom SEC EDGAR Server auf Ihren lokalen PC zu laden. Beispielsweise können Sie die zu ladenden XBRL-Filings auf bestimmte Form Types einschränken (z.B. nur Jahresabschlüsse via „Form 10-K“ oder nur Quartalsabschlüsse via „Form 10-Q“).
Anleitung:
- 1. Navigieren Sie zum RSS Feed Archive der SEC, selektieren Sie einen Monat und speichern Sie die entsprechende RSS Feed Datei (z.B. "xbrlrss-2018-01.xml") lokal ab.
- 2. Öffnen Sie den XBRL-RSS-Feed-Reader und wählen Sie im Dropdown-Feld "C13" die Dokumentart (engl. Form Type) aus, die Sie vom SEC Server herunterladen möchten. Beispielsweise können Sie die Auswahl auf Jahresabschlüsse (10-K) oder Quartalsabschlüsse (10-Q) beschränken.
- 3. Klicken Sie auf den Button "Start Download !". Es öffnet sich ein Dialogfenster, in dem die entsprechende RSS Feed Datei auszuwählen ist.
- 4. Es öffnet sich ein weiteres Fenster, in dem Sie aufgefordert werden, einen lokalen Speicherort (z.B. "D:\Downloads\XBRL") zu definieren. In diesen Ordner werden die einzelnen XBRL-Dokumente im Zip-Format abgespeichert.
- 5. Nach Auswahl des Speicherortes startet der Download der Filings vom SEC Server. Der VBA-Code liest die unter 1.) ausgewählte RSS Feed Datei schrittweise aus, lädt alle XBRL Filings automatisch herunter und speichert diese in dem unter 4.) definierten Download Ordner ab.
Tipp: Wenn Sie alle XBRL-Filings vom SEC EDGAR Server herunterladen möchten, sind das aktuell 162 Monate (04/2005 bis 09/2018) und 260.332 Filings. Es werden ca. 40 GB Speicherplatz benötigt (gezippt).
Installationshinweis:
Um das VBA-Makro vollumfänglich nutzen zu können, ist es notwendig, die Objektbibliothek "Microsoft XML" zu aktivieren. Hierzu müssen Sie zunächst in der Registerkarte "Entwicklertools" in das Visual Basic-Projektfenster wechseln. Über das Navigationsmenü "Extras" gelangen Sie dann in die Rubrik "Verweise", in der die Objektbibliothek ausgewählt und durch das Setzen eines Häckchens aktiviert werden kann. Sofern die Registerkarte "Entwicklertools" im Menüband nicht angezeigt wird, finden Sie hier eine Anleitung, wie Sie diese dauerhaft hinzufügen können.
Download XBRL RSS Feed Reader (xlsm-File, 52KB)
(Version: 1.0, 2018)
VBA-Quellcode
Abrufbar über die Entwickungsumgebung im Visual Basic-Projektfenster.
Sub XBRL_RSS_Feed_Reader()
Dim strFile As String
Dim varFname As Variant
varFname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xml*), *.xml*", Title:="Select XBRL RSS Feed", MultiSelect:=False)
strFile = Dir(varFname)
Dim strDownFolder As String
strDownFolder = GetFolder("Select Download Folder")
Do While Len(strFile) > 0
' Extract item data
Dim xmlDoc As MSXML2.DOMDocument
Set xmlDoc = New MSXML2.DOMDocument
xmlDoc.async = False
xmlDoc.validateOnParse = True
xmlDoc.Load (varFname)
Dim varList As Variant
Dim ndlstAtom As MSXML2.IXMLDOMNodeList
Set ndlstAtom = xmlDoc.SelectNodes("//atom:link")
Dim ndAtom As MSXML2.IXMLDOMNode
Dim strAtom As String
For Each ndAtom In ndlstAtom
For Each ndAtomAttribute In ndAtom.Attributes
If ndAtomAttribute.Name = "href" Then
strAtom = ndAtomAttribute.Text
End If
Next
Next
Dim ndlstItem As MSXML2.IXMLDOMNodeList
Set ndlstItem = xmlDoc.SelectNodes("//item")
Dim ndItem As MSXML2.IXMLDOMNode
If ndlstItem.Length > 0 Then
ReDim varList(1 To ndlstItem.Length, 1 To 26) As Variant
x = 0
For Each ndItem In ndlstItem
x = x + 1
varList(x, 1) = strAtom
For Each ndItemChild In ndItem.ChildNodes
If ndItemChild.nodeName = "title" Then
varList(x, 2) = ndItemChild.Text
End If
If ndItemChild.nodeName = "guid" Then
varList(x, 3) = ndItemChild.Text
End If
If ndItemChild.nodeName = "edgar:xbrlFiling" Then
For Each ndItemChild2 In ndItemChild.ChildNodes
If ndItemChild2.nodeName = "edgar:accessionNumber" Then
varList(x, 4) = ndItemChild2.Text
End If
If ndItemChild2.nodeName = "edgar:formType" Then
varList(x, 5) = ndItemChild2.Text
End If
If ndItemChild2.nodeName = "edgar:cikNumber" Then
varList(x, 6) = ndItemChild2.Text
End If
If ndItemChild2.nodeName = "edgar:filingDate" Then
varList(x, 7) = ndItemChild2.Text
End If
If ndItemChild2.nodeName = "edgar:assignedSic" Then
varList(x, 8) = ndItemChild2.Text
End If
If ndItemChild2.nodeName = "edgar:period" Then
varList(x, 9) = ndItemChild2.Text
End If
If ndItemChild2.nodeName = "edgar:xbrlFiles" Then
y = 0
For Each ndItemChild3 In ndItemChild2.ChildNodes
y = y + 1
Next
ReDim ListFiles(1 To y, 1 To 4) As Variant
Z = 0
For Each ndItemChild3 In ndItemChild2.ChildNodes
Z = Z + 1
For Each ndItemChild3Attribute In ndItemChild3.Attributes
If ndItemChild3Attribute.Name = "edgar:sequence" Then
ListFiles(Z, 1) = ndItemChild3Attribute.Text
End If
If ndItemChild3Attribute.Name = "edgar:file" Then
ListFiles(Z, 2) = ndItemChild3Attribute.Text
End If
If ndItemChild3Attribute.Name = "edgar:type" Then
ListFiles(Z, 3) = ndItemChild3Attribute.Text
End If
If ndItemChild3Attribute.Name = "edgar:url" Then
ListFiles(Z, 4) = ndItemChild3Attribute.Text
End If
Next
Next
For v = LBound(ListFiles) To UBound(ListFiles)
If ListFiles(v, 1) = "1" Then
varList(x, 13) = ListFiles(v, 2)
varList(x, 14) = ListFiles(v, 4)
End If
If ListFiles(v, 3) = "EX-101.INS" Or ListFiles(v, 3) = "EX-100.INS" Then
varList(x, 15) = ListFiles(v, 2)
varList(x, 16) = ListFiles(v, 4)
End If
If ListFiles(v, 3) = "EX-101.SCH" Or ListFiles(v, 3) = "EX-100.SCH" Then
varList(x, 17) = ListFiles(v, 2)
varList(x, 18) = ListFiles(v, 4)
End If
If ListFiles(v, 3) = "EX-101.CAL" Or ListFiles(v, 3) = "EX-100.CAL" Then
varList(x, 19) = ListFiles(v, 2)
varList(x, 20) = ListFiles(v, 4)
End If
If ListFiles(v, 3) = "EX-101.DEF" Or ListFiles(v, 3) = "EX-100.DEF" Then
varList(x, 21) = ListFiles(v, 2)
varList(x, 22) = ListFiles(v, 4)
End If
If ListFiles(v, 3) = "EX-101.LAB" Or ListFiles(v, 3) = "EX-100.LAB" Then
varList(x, 23) = ListFiles(v, 2)
varList(x, 24) = ListFiles(v, 4)
End If
If ListFiles(v, 3) = "EX-101.PRE" Or ListFiles(v, 3) = "EX-100.PRE" Then
varList(x, 25) = ListFiles(v, 2)
varList(x, 26) = ListFiles(v, 4)
End If
Next v
End If
Next
End If
Next
Next
If UBound(varList) > 0 Then
Dim strFile2 As String
strFile2 = Left(strFile, InStr(strFile, ".") - 1)
MkDir strDownFolder & "\" & strFile2
End If
lastRow = Tabelle1.Cells(Rows.Count, 2).End(xlUp).Row
Dim intFormType As Integer
y = lastRow
For x = LBound(varList) To UBound(varList)
intFormType = InStr(varList(x, 5), Tabelle1.Cells(13, 3))
If intFormType > 0 Or Tabelle1.Cells(13, 3) = "All" Then
' Option 1: Download zip file
If varList(x, 3) <> "" Then
strFileZip = Right(varList(x, 3), Len(varList(x, 3)) - InStrRev(varList(x, 3), "/", , vbTextCompare))
Dim strURL As String
strURL = varList(x, 3)
Dim objHttp1 As Object
Set objHttp1 = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objHttp1.Open "GET", strURL, False
objHttp1.send
strURL = objHttp1.responseBody
If objHttp1.Status = 200 Then
Set objStream1 = CreateObject("ADODB.Stream")
objStream1.Open
objStream1.Type = 1
objStream1.Write objHttp1.responseBody
objStream1.SaveToFile (strDownFolder & "/" & strFile2 & "/" & strFileZip & "")
objStream1.Close
y = y + 1
Tabelle1.Cells(y, 2) = varList(x, 1)
Tabelle1.Cells(y, 3) = varList(x, 2)
Tabelle1.Cells(y, 4) = varList(x, 3)
Tabelle1.Cells(y, 5) = varList(x, 4)
Tabelle1.Cells(y, 6) = varList(x, 5)
Tabelle1.Cells(y, 7) = varList(x, 6)
Tabelle1.Cells(y, 8) = varList(x, 7)
Tabelle1.Cells(y, 9) = varList(x, 8)
Tabelle1.Cells(y, 10) = varList(x, 9)
End If
End If
' Option 2: Download single xbrl files, if no zip file available
If varList(x, 3) = "" Then
MkDir strDownFolder & "\" & strFile2 & "\" & varList(x, 4) & ""
If varList(x, 15) <> "" Then
Dim strURL2 As String
strURL2 = varList(x, 16)
Dim objHttp2 As Object
Set objHttp2 = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objHttp2.Open "GET", strURL2, False
objHttp2.send
strURL2 = objHttp2.responseBody
If objHttp2.Status = 200 Then
Set objStream2 = CreateObject("ADODB.Stream")
objStream2.Open
objStream2.Type = 1
objStream2.Write objHttp2.responseBody
objStream2.SaveToFile (strDownFolder & "/" & strFile2 & "/" & varList(x, 4) & "/" & varList(x, 15) & "")
objStream2.Close
End If
End If
If varList(x, 17) <> "" Then
Dim strURL3 As String
strURL3 = varList(x, 18)
Dim objHttp3 As Object
Set objHttp3 = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objHttp3.Open "GET", strURL3, False
objHttp3.send
strURL3 = objHttp3.responseBody
If objHttp3.Status = 200 Then
Set objStream3 = CreateObject("ADODB.Stream")
objStream3.Open
objStream3.Type = 1
objStream3.Write objHttp3.responseBody
objStream3.SaveToFile (strDownFolder & "/" & strFile2 & "/" & varList(x, 4) & "/" & varList(x, 17) & "")
objStream3.Close
End If
End If
If varList(x, 19) <> "" Then
Dim strURL4 As String
strURL4 = varList(x, 20)
Dim objHttp4 As Object
Set objHttp4 = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objHttp4.Open "GET", strURL4, False
objHttp4.send
strURL4 = objHttp4.responseBody
If objHttp4.Status = 200 Then
Set objStream4 = CreateObject("ADODB.Stream")
objStream4.Open
objStream4.Type = 1
objStream4.Write objHttp4.responseBody
objStream4.SaveToFile (strDownFolder & "/" & strFile2 & "/" & varList(x, 4) & "/" & varList(x, 19) & "")
objStream4.Close
End If
End If
If varList(x, 21) <> "" Then
Dim strURL5 As String
strURL5 = varList(x, 22)
Dim objHttp5 As Object
Set objHttp5 = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objHttp5.Open "GET", strURL5, False
objHttp5.send
strURL5 = objHttp5.responseBody
If objHttp5.Status = 200 Then
Set objStream5 = CreateObject("ADODB.Stream")
objStream5.Open
objStream5.Type = 1
objStream5.Write objHttp5.responseBody
objStream5.SaveToFile (strDownFolder & "/" & strFile2 & "/" & varList(x, 4) & "/" & varList(x, 21) & "")
objStream5.Close
End If
End If
If varList(x, 23) <> "" Then
Dim strURL6 As String
strURL6 = varList(x, 24)
Dim objHttp6 As Object
Set objHttp6 = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objHttp6.Open "GET", strURL6, False
objHttp6.send
strURL6 = objHttp6.responseBody
If objHttp6.Status = 200 Then
Set objStream6 = CreateObject("ADODB.Stream")
objStream6.Open
objStream6.Type = 1
objStream6.Write objHttp6.responseBody
objStream6.SaveToFile (strDownFolder & "/" & strFile2 & "/" & varList(x, 4) & "/" & varList(x, 23) & "")
objStream6.Close
End If
End If
If varList(x, 25) <> "" Then
Dim strURL7 As String
strURL7 = varList(x, 26)
Dim objHttp7 As Object
Set objHttp7 = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objHttp7.Open "GET", strURL7, False
objHttp7.send
strURL7 = objHttp7.responseBody
If objHttp7.Status = 200 Then
Set objStream7 = CreateObject("ADODB.Stream")
objStream7.Open
objStream7.Type = 1
objStream7.Write objHttp7.responseBody
objStream7.SaveToFile (strDownFolder & "/" & strFile2 & "/" & varList(x, 4) & "/" & varList(x, 25) & "")
objStream7.Close
End If
End If
Dim FileNameZip, FolderName
Dim objApp As Object
FolderName = strDownFolder & "\" & strFile2 & "\" & varList(x, 4) & "\"
FileNameZip = strDownFolder & "\" & strFile2 & "\" & varList(x, 4) & ".zip"
Open FileNameZip For Output As #2
Print #2, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #2
Set objApp = CreateObject("Shell.Application")
objApp.Namespace(FileNameZip).CopyHere objApp.Namespace(FolderName).items
On Error Resume Next
Do Until objApp.Namespace(FileNameZip).items.Count = _
objApp.Namespace(FolderName).items.Count
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
On Error Resume Next
Kill strDownFolder & "\" & strFile2 & "\" & varList(x, 4) & "\*.*"
RmDir strDownFolder & "\" & strFile2 & "\" & varList(x, 4) & "\"
On Error GoTo 0
y = y + 1
Tabelle1.Cells(y, 2) = varList(x, 1)
Tabelle1.Cells(y, 3) = varList(x, 2)
Tabelle1.Cells(y, 4) = varList(x, 3)
Tabelle1.Cells(y, 5) = varList(x, 4)
Tabelle1.Cells(y, 6) = varList(x, 5)
Tabelle1.Cells(y, 7) = varList(x, 6)
Tabelle1.Cells(y, 8) = varList(x, 7)
Tabelle1.Cells(y, 9) = varList(x, 8)
Tabelle1.Cells(y, 10) = varList(x, 9)
End If
End If
Next
End If
strFile = Dir()
Loop
MsgBox "Download completed. Number of files: " & y - lastRow
End Sub
________________________________________________________________________
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function