Hier der Code. Vielen Dank für eure Hilfe schonmal.

Sub fImport_STA()
    Dim rs As DAO.Recordset
    Dim sPath As String
    Dim sFile As String
    Dim vIdent As Variant
    Dim vArrFile As Variant
    Dim vArrRec As Variant
    Dim vArrText As Variant
    Dim i As Long
    Dim j As Long
    Dim k As Long
    ' -- Zwischenspeichervariablen
    Dim sBLZ As String
    Dim sKTO As String
    Dim sAuszug As String
    Dim dDate As Date
    Dim dBetrag As Double
    Dim sSH As String
    Dim sArt As String
    Dim sText1 As String
    Dim sText2 As String
  
    Set rs = CurrentDb.OpenRecordset("tblDaten", dbOpenDynaset)
    vIdent = Array(":61", ":86", "?20")
    sPath = "C:\Users\cl7k7pe0001\Desktop\Nachlieferung_2014_STA-Format"
    sFile = Dir$(sPath & "*.STA")
    Do While sFile > vbNullString
        vArrFile = Split(fReadFile(sPath & sFile), "-")
        k = 0
        For i = 0 To UBound(vArrFile) - 1
            vArrRec = Split(vArrFile(i), vbCrLf)
            'k=0
            For j = 1 To UBound(vArrRec)
                Select Case Left$(vArrRec(j), 3)
                  Case ":25"
                    sBLZ = Mid$(vArrRec(j), 5, 8)
                    sKTO = Mid$(vArrRec(j), 14, 10)
                  Case ":28"
                    sAuszug = Mid$(vArrRec(j), 6, 5)
                  Case vIdent(k)
                    Select Case k
                      Case 0
                        dDate = CDate(Format$("20" & Mid$(vArrRec(j), 5, 6) _
                                            , "@@@@-@@-@@"))
                        sSH = Mid$(vArrRec(j), 15, 1)
                        If InStr(16, vArrRec(j), "N") > 0 Then
                            If InStr(11, vArrRec(j), "C") > 0 Then
                               head = Mid$(vArrRec(j), 11)
                               tmpBetrag = Mid(head, 2, InStr(1, head, "N") - 2)
                            Else
                               head = Mid$(vArrRec(j), 11)
                               tmpBetrag = "-" + Mid(head, 2, InStr(1, head, "N") - 2)
                            End If
                            dBetrag = CDbl(tmpBetrag)
                          Else
                            dBetrag = CDbl(Mid$(vArrRec(j), 16))
                        End If
                      Case 1
                        sArt = Mid$(vArrRec(j), 11, InStrRev(vArrRec(j), "?") - 6)
                        If InStr(sArt, "ABSCHLUSS") > 0 Then
                            sText1 = vbNullString
                            sText2 = vbNullString
                            k = k + 1
                        End If
                      Case 2
                        vArrText = Split(vArrRec(j), "?2")
                        sText1 = Mid$(vArrText(1), 2)
                        If UBound(vArrText) > 1 Then _
                            sText2 = Mid$(vArrText(2), 2)
                    End Select
                    If k = 2 Then
                   
                        With rs
                            .AddNew
                            .Fields("BLZ") = sBLZ
                            .Fields("KTO") = sKTO
                            .Fields("Auszug") = sAuszug
                            .Fields("DatBuch") = dDate
                            .Fields("SH") = sSH
                            .Fields("Betrag") = dBetrag
                            .Fields("Art") = sArt
                            If Len(sText1) > 0 Then .Fields("Text1") = sText1
                            If Len(sText2) > 0 Then .Fields("Text2") = sText2
                            .Update
                        End With
                        k = 0
                      Else
                        k = k + 1
                    End If
                End Select
            Next j
        Next i
        sFile = Dir
    Loop
    rs.Close
    Set rs = Nothing
End Sub

Function fFindSubString(ByVal SourceString As String _
                      , ByVal StartTag As String, ByVal EndTag As String _
                      , Optional ByRef StartPos As Long = 1) As String
    Dim lngStartPos As Long, lngEndPos As Long
  
    lngStartPos = InStr(StartPos, SourceString, StartTag, vbTextCompare)
    If lngStartPos <= 0 Then
        Exit Function
    End If
    lngStartPos = lngStartPos + Len(StartTag)
    lngEndPos = InStr(lngStartPos, SourceString, EndTag, vbTextCompare)
    If lngEndPos <= 0 Then
        Exit Function
    End If
    StartPos = lngStartPos
    fFindSubString = Trim$(Mid$(SourceString, lngStartPos _
                              , lngEndPos - lngStartPos))
End Function

Function fReadFile(ByRef Path As String) As String
    Dim FileNr As Long
  
    'Falls nicht vorhanden, nichts zurückgeben:
    On Error Resume Next
    If FileLen(Path) = 0 Then Exit Function
    On Error GoTo 0
    'Datei einlesen:
    FileNr = FreeFile
    Open Path For Binary As #FileNr
    fReadFile = Space$(LOF(FileNr))
    Get #FileNr, , fReadFile
    Close #FileNr
End Function