Freelance Project Requests info@CodeDocu.de Software Development in C# WPF Asp.Net Core Vba Excel Word SQL-Server EF Linq, UWP Net
#

 

This code example shows how to read certain text lines from a PDF document in vba in Access.

Procedure:

For application, the PDF_Text_Reader is integrated into the Office application and the text of the PDF document is read out.

Subsequently, all text lines are run through individually and checked for a filter in the text line.

If the text pattern exists, then the line is processed further.

 

Subject: Under Access, Excel, Word

 

 

The PDF text reader is embedded with

    '< get PDF Text >

    Dim pdf_Reader As New Pdf_Text_Reader.pdf_Reader

    sText = pdf_Reader.get_Text(sFilename)

    '</ get PDF Text >

 

 

Find specific lines.

 

To edit only certain lines, you have to put a filter on the line.

In the example, each booking begins with a date 01.02. and ends with H or S.

That's why the filter is

If sLine Like "??.??. *S" Or sLine Like "??.??. *H" Then

..

End If

 

 

Then all lines are run through individually and only if the line filter is true, the line is evaluated

    '----< Read as Lines >----

    Dim arrLines

    arrLines = Split(sText, vbLf)

     

    Dim vLine

    For Each vLine In arrLines

        

      Dim sLine As String

      sLine = vLine

        

      If sLine Like "??.??. *S" Or sLine Like "??.??. *H" Then

         '--< Buchung: Zeile1 >----

         '*get first date        

         Dim iPos As Integer

         iPos = InStr(1, sLine, " ", vbTextCompare)

         sDtBuchung = Mid(sLine, 1, iPos - 1) + sJahr

         '--</ Buchung: Zeile1 >----

      End If

 

    Next

    '----</ Read as Lines >----

 

 

 

Vba code page

In Access

 

Read area

 

In the example for reading bank documents, only the area is read which goes from account statement booking data beginning to end.

The range begins with an old account balance and ends with a new account balance.

Therefore, a control character bStart and bEnd must be set at the beginning and end of the range.

If sLine Like "*alter Kontostand *S" Or sLine Like "*alter Kontostand *H" Then

            '< Start Bereich >

            bStart = True

            '</ Start Bereich >

        ElseIf sLine Like "*neuer Kontostand *S" Or sLine Like "*neuer Kontostand *H" Then

            '-< Ende Zeile >-            

            bEnd = True

            Exit For

            '-</ Ende Zeile >-

        Else

 

Subsequently, it is read in only if these two range control characters are active.

Public Sub Datei_einlesen(ByVal sFilename As String)

    '-----------< Datei_einlesen() >-----------

    '< get PDF Text >

    Dim pdf_Reader As New Pdf_Text_Reader.pdf_Reader

    sText = pdf_Reader.get_Text(sFilename)

    '</ get PDF Text >

 

    '----< Read as Lines >----

    Dim arrLines

    arrLines = Split(sText, vbLf)

 

    Dim bStart As Boolean, bEnd As Boolean

    bStart = False

    bEnd = False

    Dim IDImport As Long

    Dim sKontakt As String, sVorgang As String, sVerwendungszweck As String, sDtBuchung As String, sDtWert As String, sBetrag_Euro As String

    sKontakt = "" : sVorgang = "" : sVerwendungszweck = "" : sDtBuchung = "" : sDtWert = "" : sBetrag_Euro = ""

    Dim sJahr As String

    sJahr = ""

    Dim iLine As Integer, iBuchungszeile As Integer

    iLine = 1

    Dim vLine

    For Each vLine In arrLines

        iLine = iLine + 1

        Dim sLine As String

        sLine = vLine

        If sLine Like "*alter Kontostand *S" Or sLine Like "*alter Kontostand *H" Then

            '< Start Bereich >

            bStart = True

            iBelegzeile = 0

            '</ Start Bereich >

        ElseIf sLine Like "*neuer Kontostand *S" Or sLine Like "*neuer Kontostand *H" Then

            '-< Ende Zeile >-

            '< anfuegen >

            If Not sDtBuchung Like "" Then

                Beleg_anfuegen sKontakt, sVorgang, sVerwendungszweck, sDtBuchung, sDtWert, sBetrag_Euro

            End If

            '</ anfuegen >

            bEnd = True

            Exit For

            '-</ Ende Zeile >-

        Else

            '----< Buchungs-Zeilen >----

            If bStart = False And bEnd = False Then

                '--< Bereich: Beleg-Kopf >--

                If sLine Like "*Kontoauszug*Nr.*/*" Then

                    Dim iPosJahr As Integer

                    iPosJahr = InStr(1, sLine, "/", vbBinaryCompare)

 

                    sJahr = Mid(sLine, iPosJahr + 1)

                End If

                '--</ Bereich: Beleg-Kopf >--

            ElseIf bStart = True And bEnd = False Then

                '--< Bereich: Buchungen >--

                iBuchungszeile = iBuchungszeile + 1

                If sLine Like "??.??. *S" Or sLine Like "??.??. *H" Then

                    '--< Buchung: Zeile1 >----

                    '< vorige Buchung anfuegen >

                    If Not sDtBuchung Like "" Then

                        Beleg_anfuegen sKontakt, sVorgang, sVerwendungszweck, sDtBuchung, sDtWert, sBetrag_Euro

                    End If

                    '</ vorige Buchung anfuegen >

 

                    '< init Buchung >

                    iBuchungszeile = 1

                    sDtBuchung = "" : sDtWert = "" : sKontakt = "" : sVorgang = "" : sVerwendungszweck = "" : sBetrag_Euro = ""

                    '</ init Buchung >

 

                    Dim iPos As Integer

                    iPos = InStr(1, sLine, " ", vbTextCompare)

                    sDtBuchung = Mid(sLine, 1, iPos - 1) + sJahr

                    sLine = Mid(sLine, iPos + 1)

 

                    iPos = InStr(1, sLine, " ", vbTextCompare)

                    sDtWert = Mid(sLine, 1, iPos - 1) + sJahr

                    sLine = Mid(sLine, iPos + 1)

 

                    iPos = InStrRev(sLine, " ", , vbTextCompare)

                    sSoll_Haben = Mid(sLine, iPos + 1)

                    sLine = Mid(sLine, 1, iPos - 1)

 

                    iPos = InStrRev(sLine, " ", , vbTextCompare)

                    sBetrag_Euro = Mid(sLine, iPos + 1)

                    If sSoll_Haben Like "S" Then

                        sBetrag_Euro = "-" & sBetrag_Euro

                    End If

                    sLine = Mid(sLine, 1, iPos - 1)

                    sVorgang = Trim(sLine)

                    '--</ Buchung: Zeile1 >----

                Else

                    '--< Buchung: Zeile2_bis_n >----

                    sLine = Trim(sLine)

                    If iBuchungszeile = 2 Then

                        sKontakt = sLine

                    Else

                        sVerwendungszweck = sVerwendungszweck & vbCrLf & sLine

                    End If

                    '--</ Buchung: Zeile2_bis_n >----

                End If

                '--</ Bereich: Buchungen >--

            End If

        End If

 

    Next

    '----</ Read as Lines >----

 

    '-----------</ Datei_einlesen() >-----------

End Sub

 

 

 

 

Reference: vba code

Complete code example in vba

Option Compare Database

 

 

Private Sub BtnImport_Click()

    Select_File()

End Sub

 

 

'*Reference Microsoft scripting Runtime    http://www.microsoft-programmierer.de/Details?d=1076

Public Sub Select_File()

    '-----------< Select_File() >-----------

    '--< File-Dialog >--

    Dim objFiledialog As FileDialog

    Set objFiledialog = Application.FileDialog(msoFileDialogFilePicker)

    objFiledialog.AllowMultiSelect = True

    objFiledialog.ButtonName = "->Select Files"

    objFiledialog.filters.Add "Add Files""*.pdf"

    objFiledialog.title = "Select Files.."

    objFiledialog.InitialView = msoFileDialogViewTiles

    objFiledialog.InitialFileName = CurrentProject.Path

    objFiledialog.AllowMultiSelect = True

    If Not objFiledialog.Show() = True Then

        Exit Sub

    End If

    '--< File-Dialog >--

 

    '-< check >-

    '</ Ordner ist leer >

    If objFiledialog.SelectedItems().Count = 0 Then

        Exit Sub

    End If

    '</ Ordner ist leer >

 

    '-</ check >-

 

    Dim sFilename As String

    Dim sFiles As String

    sFiles = ""

    '----< @Loop: Files >----

 

    Dim iFile As Integer

    For iFile = 1 To objFiledialog.SelectedItems.Count

        '------< Loop.Item  >------

        DoEvents

        '< get selection >

        sFilename = objFiledialog.SelectedItems(iFile)

        '</ get selection >

 

        '--< importieren >--

        Datei_einlesen(sFilename)

        Beleg_Import_speichern(sFilename)

        Daten_Übertragen

        '--</ importieren >--

 

 

    Next

    '----</ @Loop: Files >----

 

    '-----------</ Select_File() >-----------

End Sub

 

Public Sub Datei_einlesen(ByVal sFilename As String)

    '-----------< Datei_einlesen() >-----------

    '< get PDF Text >

    Dim pdf_Reader As New Pdf_Text_Reader.pdf_Reader

    sText = pdf_Reader.get_Text(sFilename)

    '</ get PDF Text >

 

    '----< Read as Lines >----

    Dim arrLines

    arrLines = Split(sText, vbLf)

 

    Dim bStart As Boolean, bEnd As Boolean

    bStart = False

    bEnd = False

    Dim IDImport As Long

    Dim sKontakt As String, sVorgang As String, sVerwendungszweck As String, sDtBuchung As String, sDtWert As String, sBetrag_Euro As String

    sKontakt = "" : sVorgang = "" : sVerwendungszweck = "" : sDtBuchung = "" : sDtWert = "" : sBetrag_Euro = ""

    Dim sJahr As String

    sJahr = ""

    Dim iLine As Integer, iBuchungszeile As Integer

    iLine = 1

    Dim vLine

    For Each vLine In arrLines

        iLine = iLine + 1

        Dim sLine As String

        sLine = vLine

        If sLine Like "*alter Kontostand *S" Or sLine Like "*alter Kontostand *H" Then

            '< Start Bereich >

            bStart = True

            iBelegzeile = 0

            '</ Start Bereich >

        ElseIf sLine Like "*neuer Kontostand *S" Or sLine Like "*neuer Kontostand *H" Then

            '-< Ende Zeile >-

            '< anfuegen >

            If Not sDtBuchung Like "" Then

                Beleg_anfuegen sKontakt, sVorgang, sVerwendungszweck, sDtBuchung, sDtWert, sBetrag_Euro

            End If

            '</ anfuegen >

            bEnd = True

            Exit For

            '-</ Ende Zeile >-

        Else

            '----< Buchungs-Zeilen >----

            If bStart = False And bEnd = False Then

                '--< Bereich: Beleg-Kopf >--

                If sLine Like "*Kontoauszug*Nr.*/*" Then

                    Dim iPosJahr As Integer

                    iPosJahr = InStr(1, sLine, "/", vbBinaryCompare)

 

                    sJahr = Mid(sLine, iPosJahr + 1)

                End If

                '--</ Bereich: Beleg-Kopf >--

            ElseIf bStart = True And bEnd = False Then

                '--< Bereich: Buchungen >--

                iBuchungszeile = iBuchungszeile + 1

                If sLine Like "??.??. *S" Or sLine Like "??.??. *H" Then

                    '--< Buchung: Zeile1 >----

                    '< vorige Buchung anfuegen >

                    If Not sDtBuchung Like "" Then

                        Beleg_anfuegen sKontakt, sVorgang, sVerwendungszweck, sDtBuchung, sDtWert, sBetrag_Euro

                    End If

                    '</ vorige Buchung anfuegen >

 

                    '< init Buchung >

                    iBuchungszeile = 1

                    sDtBuchung = "" : sDtWert = "" : sKontakt = "" : sVorgang = "" : sVerwendungszweck = "" : sBetrag_Euro = ""

                    '</ init Buchung >

 

                    Dim iPos As Integer

                    iPos = InStr(1, sLine, " ", vbTextCompare)

                    sDtBuchung = Mid(sLine, 1, iPos - 1) + sJahr

                    sLine = Mid(sLine, iPos + 1)

 

                    iPos = InStr(1, sLine, " ", vbTextCompare)

                    sDtWert = Mid(sLine, 1, iPos - 1) + sJahr

                    sLine = Mid(sLine, iPos + 1)

 

                    iPos = InStrRev(sLine, " ", , vbTextCompare)

                    sSoll_Haben = Mid(sLine, iPos + 1)

                    sLine = Mid(sLine, 1, iPos - 1)

 

                    iPos = InStrRev(sLine, " ", , vbTextCompare)

                    sBetrag_Euro = Mid(sLine, iPos + 1)

                    If sSoll_Haben Like "S" Then

                        sBetrag_Euro = "-" & sBetrag_Euro

                    End If

                    sLine = Mid(sLine, 1, iPos - 1)

                    sVorgang = Trim(sLine)

                    '--</ Buchung: Zeile1 >----

                Else

                    '--< Buchung: Zeile2_bis_n >----

                    sLine = Trim(sLine)

                    If iBuchungszeile = 2 Then

                        sKontakt = sLine

                    Else

                        sVerwendungszweck = sVerwendungszweck & vbCrLf & sLine

                    End If

                    '--</ Buchung: Zeile2_bis_n >----

                End If

                '--</ Bereich: Buchungen >--

            End If

        End If

 

    Next

    '----</ Read as Lines >----

 

    '-----------</ Datei_einlesen() >-----------

End Sub

 

 

 

Public Sub Beleg_anfuegen(ByVal sKontakt As String, sVorgang As String, sVerwendungszweck As String, sDtBuchung As String, sDtWert As String, sBetrag_Euro As String)

    '-----------< Beleg_anfuegen() >-----------

    '< korrektur >

    sVerwendungszweck = Replace(sVerwendungszweck, vbCrLf, "", 1, 1, vbBinaryCompare)

    '</ korrektur >

 

    Dim recBuchung As Recordset

    Set recBuchung = CurrentDb.OpenRecordset("SELECT TOP 1 * FROM _tbl_Import_Belege", dbOpenDynaset)

    

    recBuchung.AddNew

    recBuchung("Kontakt") = sKontakt

    recBuchung("Vorgang") = sVorgang

    recBuchung("Verwendungszweck") = sVerwendungszweck

    recBuchung("DtBuchung") = sDtBuchung

    recBuchung("DtWert") = sDtWert

    recBuchung("Betrag_Euro") = sBetrag_Euro

    recBuchung.Update

 

    recBuchung.Close

    Set recBuchung = Nothing

    '-----------</ Beleg_anfuegen() >-----------

End Sub

 

Public Sub Beleg_Import_speichern(ByVal sFilename As String)

    '-----------< Beleg_anfuegen() >-----------

    '< correct >

    Dim iPos As Integer

    iPos = InStrRev(sFilename, "\", -1, vbBinaryCompare)

    sFilename = Mid(sFilename, iPos + 1)

    '</ correct >

 

    Dim IDBeleg As Long

    Dim intAnzahl_Buchungen As Integer

    intAnzahl_Buchungen = DCount("IDBeleg""tbl_Import_Belege")

 

    '< anfuegen >

    Dim recBeleg As Recordset

    Set recBeleg = CurrentDb.OpenRecordset("SELECT TOP 1 * FROM tbl_Import_Belege WHERE Belegname like '" & sFilename & "'", dbOpenDynaset)

    If recBeleg.EOF Then

        recBeleg.AddNew

    Else

        recBeleg.Edit

    End If

 

    recBeleg("dtImport") = Now

    recBeleg("Belegname") = sFilename

    recBeleg("Anzahl_Buchungen") = intAnzahl_Buchungen

    recBeleg.Update

 

    recBeleg.Close

    Set recBeleg = Nothing

    '</ anfuegen >

    

    

    '< aktualisieren >

    ctlList_Importe.Requery

    '</ aktualisieren >

    '-----------</ Beleg_anfuegen() >-----------

End Sub

 

 

 

Mobile

.

Contact for Jobs, Project Requests: raimund.popp@microsoft-programmierer.de