stern123
Goto Top

VBA: Wert von einer Website (pdf-Dokument) auslesen und in Excel kopieren

Hallo zusammen,

ich bin blutiger Anfänger hinsichtlich VBA und versuche nun schon seit mehreren Tagen folgendes Problem zu lösen: Ich möchte auf dieser Website (https://www.ffiec.gov/nicpubweb/nicweb/SearchForm.aspx?pS=2) automatisch einen Wert aus den PDF-Dokumenten der jeweiligen Banken auslesen und in Excel kopieren, im Detail soll es so funktionieren:

Ich habe eine Excel-Liste mit mehreren Banken, welche durch eine eindeutige Identifikationsnummer zugeordnet werden können:

Bsp:
Bank 1 -->RSSD ID: 966012
Bank 2 -->RSSD ID: 633819
Bank 3 -->...

Ich habe nun bereits herausgefunden, wie ich die jeweiligen URL-Adressen zur pdf-Datei ansteuern kann, da diese sich jeweils aus der RSSD ID und dem Datum zusammensetzen:. Das Öffnen der Datei bekomme ich also noch hin: https://www.ffiec.gov/nicpubweb/NICDataCache/FFIEC002/FFIEC002_633819_20 ...

Ich möchte nun aus diesen PDFs immer den gleichen Wert kopieren (Das Dokument ist immer gleich aufgebaut, der Wert also an der gleichen Stelle auf Seite 8):
c. All other banks in foreign countries and foreign central banks ................ 3149 --> 2033 (wäre für diese Bank der Wert, den ich gerne in Excel ausgegeben bekommen würde).


Da es eine pdf-Datei ist, bin ich mir auch gar nicht sicher, ob dies überhaupt realisierbar ist. Ich arbeite mit Office 2007. Habt ihr vielleicht eine Idee, wie ich am besten vorgesehen sollte?

Vielen Dank für Eure Hilfe!!
Beste Grüße,
Jannis

Content-Key: 311418

Url: https://administrator.de/contentid/311418

Ausgedruckt am: 28.03.2024 um 08:03 Uhr

Mitglied: 129813
Lösung 129813 31.07.2016 aktualisiert um 19:28:46 Uhr
Goto Top
Hi,
normally this can be done with the commandline tool pdftotext (extracting text from pdf's). But in this case, the above pdf's have a problem, the tool can read the number 3149 but not the "blue" numbers, they are missing in the extracted text from pdftotext. So this tool cannot be used for it, i tested it.

The line after extracting looks like this
c. All other banks in foreign countries and foreign central banks ................ 3149 3149 4.c.
(you see the number is missing face-sad)

If this woudn't be the case, this would be an easy task.

If you have Acrobat Professional the data could be extracted because this PDF is assembled using Adobe LifeCycle Designer. The data could then be extracted via JavaScript.

Regards
Mitglied: Stern123
Stern123 31.07.2016 um 20:09:27 Uhr
Goto Top
Hi highload,

thank you for your quick reply and your help! I really appreciate it.

Actually I don't know whether we have the opportunitiy to use Acrobat Professional at work. I'll figure it out tomorrow and give you an update face-smile

Hope it is possible.

Best,
Jannis
Mitglied: Stern123
Stern123 01.08.2016 um 04:27:19 Uhr
Goto Top
Hi Highload,

Finally I have found a trial version of Acrobat Professional, which is already installed now face-smile

It would be really great if you explain me, what I have to do now in order to get the figures from the pdf into my excel spreadsheet. Do I have to download the file first or can I convert the figures directly?

Thanks a lot for your help!

Best,
Jannis
Mitglied: ashnod
ashnod 01.08.2016 um 09:03:36 Uhr
Goto Top
Zitat von @Stern123:
It would be really great if you explain me, what I have to do now in order to get the figures from the pdf into my excel spreadsheet. Do I have to download the file first or can I convert the figures directly?

Ahoi,

also so ganz easy sehe ich das nicht ... wie Highload beschreibt ist die PDF mit Adobe LC (LiveCycle) erstellt worden.
Zumindest bis Acrobat X Pro .... konnte man diese Dateien nicht im Acrobat Pro bearbeiten, sondern dieser ruft dann den LC auf, der bis dahin noch Bestandteil von Acrobat Pro war.

Zudem denke ich doch eher das du eine automatisiete Lösung suchst, oder wolltest du selbst viel nachbearbeiten?

VG

Ashnod
Mitglied: colinardo
Lösung colinardo 01.08.2016 aktualisiert um 13:59:25 Uhr
Goto Top
Hallo @Stern123, willkommen auf Administrator.de!
alles kein Hexenwerk ... face-wink, wenn ich mal für @129813 übernehmen darf.

Ich gehe mal davon aus das die RSSD-IDs in deinem Sheet ab Zeile A2:AXX stehen. Der folgende Code schreibt die extrahierten Daten dann in die Zelle daneben in Spalte B.

WICHTIGE HINWEISE: Damit die Extrahierung mit Acrobat fehlerfrei funktionieren kann muss in den Acrobat-Einstellungen (STRG+K) entweder die erweiterte Sicherheit deaktiviert werden (nicht empfohlen) oder dort für das unten stehende Skript der TEMP Pfad übergangsweise als Ausnahme eingetragen werden, weil dort die PDFs temporär zwischengespeichert und dann ausgelesen werden:

screenshot

Wird dies nicht gemacht, kann das Skript nicht auf die Daten zugreifen und es können keine Daten extrahiert werden !!

Sub ExtractData()
    Dim strURLGetDate As String, strTempHTML As String, strTempPDF As String, fso As Object, regex As Object
    ' Paths  
    strURLGetDate = "https://www.ffiec.gov/nicpubweb/nicweb/InstitutionProfile.aspx?parID_Rssd=######&parDT_END=99991231"  
    strTempHTML = Environ("TEMP") & "\extract_date.html"  
    strTempPDF = Environ("TEMP") & "\report.pdf"  
    'Objects  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set regex = CreateObject("vbscript.regexp")  
    regex.IgnoreCase = True
    
    With ActiveSheet
        For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)  
            ' Lade Seite mit den Datumswerten für den Report  
            If DownloadFile(Replace(strURLGetDate, "######", cell.Value, 1, 1, vbTextCompare), Environ("TEMP") & "\extract_date.html") Then  
                'extrahiere das Datum  
                strContent = fso.OpenTextFile(strTempHTML, 1, False, -2).ReadAll()
                regex.Pattern = "selected=""selected"" value=""([\d-]+)"""  
                Set matches = regex.Execute(strContent)
                If matches.Count > 0 Then
                    strDate = Replace(matches(0).submatches(0), "-", "", 1, -1, 1)  
                    ' trigger Report creation  
                    DownloadFile "https://www.ffiec.gov/nicpubweb/nicweb/FinancialReport.aspx?parID_RSSD=" & cell.Value & "&parDT=" & strDate & "&parRptType=FFIEC002&redirectPage=FinancialReport.aspx", strTempHTML  
                    'PDF Download URL  
                    strPDFURL = "https://www.ffiec.gov/nicpubweb/NICDataCache/FFIEC002/FFIEC002_" & cell.Value & "_" & strDate & ".PDF"  
                    ' Downloade PDF, extrahiere den gewünschten Wert und schreibe Ihn in die Zelle neben der RSSD-ID  
                    If DownloadFile(strPDFURL, strTempPDF) Then
                        cell.Offset(0, 1).Value = ExtractXMLFormData(strTempPDF)
                    End If
                End If
            End If
        Next
    End With
    MsgBox "Finished", vbInformation  
End Sub

'Funktion zum Herunterladen von Dateien  
Function DownloadFile(ByVal strURL As String, ByVal strTarget As String) As Boolean
    On Error GoTo Error
    Dim objhttp As Object, objStream As Object
    Set objhttp = CreateObject("Microsoft.XMLHTTP")  
    Set objStream = CreateObject("ADODB.Stream")  
    With objhttp
        .Open "GET", strURL, False  
        .send
        If .Status = 200 Then
            objStream.Open
            objStream.Type = 1
            objStream.Write .responseBody
            objStream.SaveToFile strTarget, 2 'Overwrite target  
            objStream.Close
            DownloadFile = True
        Else
            DownloadFile = False
        End If
    End With
    Exit Function
Error:
    DownloadFile = False
End Function

' XML-FormData per Acrobat JavaScript Object extrahieren  
Function ExtractXMLFormData(ByVal strPath As String) As String
    On Error GoTo Err
    Set objAcro = CreateObject("AcroExch.App")  
    Set docAV = CreateObject("AcroExch.AVDoc")  
    Set docPD = CreateObject("AcroExch.PDDoc")  
    
    docAV.Open strPath, ""  
    Set docPD = docAV.GetPDDoc()
    Set jsDoc = docPD.GetJSObject()
    ExtractXMLFormData = jsDoc.xfa.form.F.P8.Subform1.RCFD3149.rawValue
    jsDoc.closeDoc
    
    Set jsDoc = Nothing
    Set docPD = Nothing
    Set docAV = Nothing
    Set objAcro = Nothing
    Exit Function
Err:
    Set jsDoc = Nothing
    Set docPD = Nothing
    Set docAV = Nothing
    Set objAcro = Nothing
    ExtractXMLFormData = ""  
End Function
Hier noch das entsprechende Excel-Sheet als Download, falls es Missverständnisse geben sollte.
extract_bank_data_311418.xlsm

Grüße Uwe

Falls der Beitrag gefällt, seid so nett und unterstützt mich durch eine kleine Spende / If you like my contribution please support me and donate
Mitglied: 129813
129813 01.08.2016 aktualisiert um 14:07:07 Uhr
Goto Top
Zitat von @ashnod:
Zumindest bis Acrobat X Pro .... konnte man diese Dateien nicht im Acrobat Pro bearbeiten, sondern dieser ruft dann den LC auf, der bis dahin noch Bestandteil von Acrobat Pro war.
Why "editing"? Only "extracting" the data is needed, and this can be done with Acrobat too face-wink

@colinardo That's how i also thought to do it, thanks for your substitution face-smile!!

Regards
Mitglied: Stern123
Stern123 02.08.2016 um 02:21:17 Uhr
Goto Top
wow, vielen lieben Dank! Das ist genau das, was ich gebraucht habe face-smile))

Sehr nett, dass du dir die Mühe gemacht hast!!!

Beste Grüße,
Jannis
Mitglied: Stern123
Stern123 02.08.2016 um 03:00:23 Uhr
Goto Top
Hallo zusammen,

eine Frage habe noch face-wink

Wie man folgender Seite entnehmen (https://www.ffiec.gov/nicpubweb/nicweb/InstitutionProfile.aspx?parID_Rss ..) kann, kann man explizit das Datum auswählen, für welches der Report erstellt werden soll.

Ideal wäre es, wenn ich das Datum in meinem Excelsheet gezielt steuern könnte: Ich habe es euch als Bild angehängt, wie ich es mir vorgestellt habe.

Ist dies schwer in den Code einzubauen?

Vielen Dank für eure Ideen!
Jannis
frage
Mitglied: colinardo
colinardo 02.08.2016 aktualisiert um 08:30:11 Uhr
Goto Top
Hallo Jannis,
kann man explizit das Datum auswählen, für welches der Report erstellt werden soll.
Eben, aber es gibt nicht für jede Bank die gleichen Datumswerte. Ich müsste also von dir wissen was geschehen soll wenn das vom User angegebene Datum für diese Bank nicht vorhanden ist?? Mein Skript liest ja das aktuellste vorhandene Datum aus der Report-Creation Seite aus.
Mitglied: Stern123
Stern123 03.08.2016 um 13:51:56 Uhr
Goto Top
Hallo Uwe,

Danke für deine Antwort face-smile

Sofern für das Datum kein Wert vorliegt, soll nichts drinnen stehen, also "". Mir ist bewusst, dass es dann einige leere Felder gibt, das ist aber gewünscht.

Falls es für den 30.06.2016 keinen Wert gibt, dann also so:

13.03.2016 30.06.2016
345


Viele Grüße,
Jannis
Mitglied: colinardo
colinardo 03.08.2016 aktualisiert um 13:58:08 Uhr
Goto Top
Na dann reicht eine einfache zusätzliche IF-Abfrage (hier in Zeile 22):

Ändere die Sub ExtractData() folgendermaßen ab
Sub ExtractData()
    Dim strURLGetDate As String, strTempHTML As String, strTempPDF As String, fso As Object, regex As Object
    ' Paths  
    strURLGetDate = "https://www.ffiec.gov/nicpubweb/nicweb/InstitutionProfile.aspx?parID_Rssd=######&parDT_END=99991231"  
    strTempHTML = Environ("TEMP") & "\extract_date.html"  
    strTempPDF = Environ("TEMP") & "\report.pdf"  
    'Objects  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set regex = CreateObject("vbscript.regexp")  
    regex.IgnoreCase = True
    
    With ActiveSheet
        For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row)  
            ' Lade Seite mit den Datumswerten für den Report  
            If DownloadFile(Replace(strURLGetDate, "######", cell.Value, 1, 1, vbTextCompare), Environ("TEMP") & "\extract_date.html") Then  
                'extrahiere das Datum  
                strContent = fso.OpenTextFile(strTempHTML, 1, False, -2).ReadAll()
                regex.Pattern = "selected=""selected"" value=""([\d-]+)"""  
                Set matches = regex.Execute(strContent)
                If matches.Count > 0 Then
                    strDate = Replace(matches(0).submatches(0), "-", "", 1, -1, 1)  
                    If strDate = .Range("B1").Value Then  
                        ' trigger Report creation  
                        DownloadFile "https://www.ffiec.gov/nicpubweb/nicweb/FinancialReport.aspx?parID_RSSD=" & cell.Value & "&parDT=" & strDate & "&parRptType=FFIEC002&redirectPage=FinancialReport.aspx", strTempHTML  
                        'PDF Download URL  
                        strPDFURL = "https://www.ffiec.gov/nicpubweb/NICDataCache/FFIEC002/FFIEC002_" & cell.Value & "_" & strDate & ".PDF"  
                        ' Downloade PDF, extrahiere den gewünschten Wert und schreibe Ihn in die Zelle neben der RSSD-ID  
                        If DownloadFile(strPDFURL, strTempPDF) Then
                            cell.Offset(0, 1).Value = ExtractXMLFormData(strTempPDF)
                        End If
                    End If
                End If
            End If
        Next
    End With
    MsgBox "Finished", vbInformation  
End Sub
Grüße Uwe
Mitglied: 116301
Lösung 116301 04.08.2016 aktualisiert um 12:18:06 Uhr
Goto Top
Hallo zusammen!

Nachdem Uwe so gute Vorarbeit geleistet hast, habe ich mich auch mal daran versuchtface-smile

U.a. habe ich festgestellt, dass man den ResponsText (Datum und PDF) direkt matchen kann und somit die Dateierzeugungen entfallen können.

Bei meinem Code-Beispiel habe ich in der Tabelle die TO-Zeile 1 entfernt und sieht nun bei mir so aus:
report

Beim Betägigen des Aktualisierungs-Buttons passiert folgendes:
  • Schleife 1: Alle RSSD-ID's abarbeiten
  • Schleife 2: Alle Datumsspalten abarbeiten und prüfen ob die Zelle in der jeweiligen Datumsspalte Leer ist, wenn ja zusätzlich prüfen, ob das Spaltendatum im Zeitfenster des aktuellen Datums liegt.
  • Auslesen (matchen) der Optionsfelder mit Datumsangebot und einen Datumsvergleich (JJJJMM=JJJJMM) mit dem jeweiligen Spaltendatum durchführen und Match-Datum für PDF-Erzeugung übernehmen. Somit können auch rückwirkend (Jahre/Monate) alle verfügbaren Reports ausgelesen werden
  • Wenn's passt Pdf-Erzeugung anstossen und den gewünschen Wert aus dem ResponseText der Pdf-Datei auslesen.

Hier der Codeschnippsel dazu:
Option Explicit
Option Compare Text

Private Const RowStart = 3          'Bei Bedarf anpassen  
Private Const RngDates = "B2:E2"    'Bei Bedarf anpassen  

Private Const PatternDates = "<option[\D]*([^""]+)"  
Private Const PatternValue = "All other banks.*Column A[\D]*3149[\D]*(\d+)"  

Private Const UrlGetDate = "https://www.ffiec.gov/nicpubweb/nicweb/InstitutionProfile.aspx?parID_Rssd=%1&parDT_END=99991231"  
Private Const UrlGetReady = "https://www.ffiec.gov/nicpubweb/nicweb/FinancialReport.aspx?parID_RSSD=%1&parDT=%2&parRptType=FFIEC002&redirectPage=FinancialReport.aspx"  
Private Const UrlGetPDF = "https://www.ffiec.gov/nicpubweb/NICDataCache/FFIEC002/FFIEC002_%1_%2.PDF"  

Private objRegExp As Object, objHttpRequest As Object

'Diese Function aktualsiert alle noch austehende Werte (B:E), d.h. alle leere Zellen, bei denen  
'das Spaltendatum (B2:E2) im Zeitfenster des aktuellen Datums liegt und ein Report bereit steht.  
'Vorausgesetzt, dass jeweilige Datum ist in der Standardform TT.MM.JJJJ z.B. 1.3.2016 eingetragen.  
'Das Zellformat kann allerdings nach Belieben festgelegt werden.  
Private Sub BtnRefresh_Click()
    Dim objCells As Range, objDate As Range, objTarget As Range
    
    Set objRegExp = CreateObject("VBScript.RegExp")  
    Set objHttpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")  
    
    'Alle RSSD-ID's in Spalte A abarbeiten  
    For Each objCells In Range(Cells(RowStart, "A"), Cells(Rows.Count, "A").End(xlUp))  
        'Test ob Zahlenwert  
        If IsNumeric(objCells.Value) Then
            'Alle Datumsspalten abarbeiten  
            For Each objDate In Range(RngDates)
                'Test ob Zelle ein Datum enthält und im Zeitfenster mit aktuellen Datum liegt  
                If objDate.Value > 0 And objDate.Value <= Date Then
                    'Aktuelle Zelle Zeile?/Spalte? fixieren  
                    Set objTarget = Cells(objCells.Row, objDate.Column)
                    'Test ob Zelle Leer ist  
                    If IsEmpty(objTarget.Value) Then
                        'Pdf-Wert ermitteln (Zahlenwert/Empty)  
                        objTarget.Value = GetValue(objCells.Value, objDate.Value)
                    End If
                End If
            Next
        End If
    Next
    Set objRegExp = Nothing
    Set objHttpRequest = Nothing
    MsgBox "Fertig!", vbInformation  
End Sub

'Diese Function gibt einen Wert (Zahl/Empty) in Abhängigkeit von RSSD-ID und Datum zurück.  
Private Function GetValue(ByRef strID, ByVal dblDate As Date) As Variant
    Dim objMatch As Object, objMatchDate As Object, strText As String
    Dim strDate As String, strUrlPDF As String, strUrlReady As String
    
    'Website mit Datumsangebote einlesen  
    strText = GetHttpRequest(Replace(UrlGetDate, "%1", strID))  
    
    If strText <> "" Then  
        'Datumsangebote (DropBox) erfassen  
        For Each objMatchDate In GetMatchesObject(strText, PatternDates, True)
            'Abfrage-Datum in Form JJJJMMTT erzeugen  
            strDate = Replace(objMatchDate.SubMatches(0), "-", "")  
            'Test Datum  
            If Left(strDate, 6) = Format(dblDate, "YYYYMM") Then  
                'Url's erzeugen  
                strUrlPDF = Replace(Replace(UrlGetPDF, "%1", strID), "%2", strDate)  
                strUrlReady = Replace(Replace(UrlGetReady, "%1", strID), "%2", strDate)  
                'Report erzeugen und testen ob Report bereit steht  
                If InStr(GetHttpRequest(strUrlReady), "report is ready") > 0 Then  
                    'PDF als Text einlesen  
                    strText = GetHttpRequest(strUrlPDF)
                    'Test ob Pdf-Einlesen erfolgreich  
                    If strText <> "" Then  
                        'Wert ermitteln  
                        For Each objMatch In GetMatchesObject(strText, PatternValue, False)
                            'Gegebenenfalls Kommastellenzeichen englisch/deutsch ersetzen  
                            GetValue = CDbl(Replace(objMatch.SubMatches(0), ".", ","))  
                        Next
                    End If
                    Exit For
                End If
            End If
        Next
    End If
End Function

'Diese Function gibt den Quelltext einer Website als Text oder Byte-Array zurück  
Private Function GetHttpRequest(ByRef strUrl, Optional ByVal bolByte As Boolean) As Variant
    Dim i As Integer
    
    On Error Resume Next
    With objHttpRequest
            For i = 1 To 3  'maximal 3 Versuche  
               .Open "Get", strUrl, False  
               .Send
                If .Status = 200 Then
                    GetHttpRequest = IIf(bolByte, .ResponseBody, .ResponseText):  Exit For
                End If
            Next
    End With
    On Error GoTo 0
End Function

'Diese Function gibt das Match-Object zurück  
Private Function GetMatchesObject(ByRef strText, ByRef strPattern, ByVal bolGlobal As Boolean) As Object
    With objRegExp
        .Global = bolGlobal
        .IgnoreCase = True
        .Pattern = strPattern
         Set GetMatchesObject = .Execute(strText)
    End With
End Function

Grüße Dieter
Mitglied: colinardo
colinardo 04.08.2016 um 11:17:33 Uhr
Goto Top
Hallo Dieter,
schön face-smile. Ich hatte zuerst auch im Raw PDF nach dem Wert gestöbert, aber vergessen die Suche in meinem HEX-Editor umzukonfigurieren und habe es dann vorschnell verworfen und gedacht die Daten wären anderweitig kodiert.

Grüße Uwe
Mitglied: 116301
116301 04.08.2016 um 12:10:31 Uhr
Goto Top
Hallo Uwe!

schönface-smile . Ich hatte zuerst auch im Raw PDF nach dem Wert gestöbert, aber vergessen die Suche in meinem HEX-Editor umzukonfigurieren und habe es dann vorschnell verworfen und gedacht die Daten wären anderweitig kodiert.
Dankeface-smile Ich hatte mir die Pdf-Datei zunächst mal im Notepad++ angeschaut und einfach mal nach "All other banks" gesucht, was erfreulicher Weise auch auf Anhieb geklappt hat. Die AcroLib kann ich nicht einbinden, da ich nur einen Acrobat Reader DC installiert habe und es scheinbar nur mit einem Acrobat-Pro funktioniert?

Grüße Dieter
Mitglied: colinardo
Lösung colinardo 04.08.2016 um 14:12:27 Uhr
Goto Top
und es scheinbar nur mit einem Acrobat-Pro funktioniert?
Das ist richtig, das geht nur mit dem "großen" Bruder.
Mitglied: Stern123
Stern123 04.08.2016 um 15:50:03 Uhr
Goto Top
Hey,

super, vielen lieben Dank fur Eure Hilfe. Das ist echt klasse face-smile


Ich werde es direkt, wenn ich zu Hause bin, ausprobieren. Bin gespannt, ob alles klappt.

Viele Gruesse,
Jannis