Option Compare Database
Option Explicit

Type Spec
    sField As String
    nStart As Integer
    nWidth As Integer
    nType As Integer
End Type
Dim FieldList() As Spec
Dim n As Integer, sl As Integer

Private Sub FillFieldList(sSpec As String)

    Dim db As Database, rs As Recordset, i As Integer

    Set db = CurrentDb
    Set rs = db.OpenRecordset( "MSysIMEXSpecs" , dbOpenDynaset, dbReadOnly)
    rs.FindFirst  "SpecName='" & sSpec & "'" 
    n = rs!SpecID
    rs.Close
    Set rs = db.OpenRecordset( "SELECT * FROM MSysIMEXColumns WHERE SpecID="  & CStr(n) &  " ORDER BY Start" , dbOpenDynaset, dbReadOnly)
    rs.MoveLast
    n = rs.RecordCount
    ReDim FieldList( 1  To n)
    i =  1 
    rs.MoveFirst
    Do Until rs.EOF
        FieldList(i).sField = rs!FieldName
        FieldList(i).nStart = rs!Start
        FieldList(i).nWidth = rs!Width
        FieldList(i).nType = rs!DataType
        i = i +  1 
        rs.MoveNext
    Loop
    rs.Close
    sl = FieldList(n).nStart + FieldList(n).nWidth -  1 

End Sub

Sub MyImport(sSpec As String, sTable As String, sFile As String)

    Dim f As Integer, s As String, i As Integer
    Dim db As Database, rs As Recordset

    On Error GoTo err_imp
    f = FreeFile
    Open sFile For Input As #f
    Set db = CurrentDb
    Set rs = db.OpenRecordset(sTable)
    FillFieldList sSpec
    Do Until EOF(f)
        Line Input #f, s
        rs.AddNew
        For i =  1  To n
            Select Case FieldList(i).nType
                Case  10 
                    rs(FieldList(i).sField) = Mid$(s, FieldList(i).nStart, FieldList(i).nWidth)
                Case  3 
                    rs(FieldList(i).sField) = Val(Mid$(s, FieldList(i).nStart, FieldList(i).nWidth))
                Case  8 
                    'тут можно дописать'
            End Select
        Next
        rs.Update
    Loop
    rs.Close
    Close #f
    Exit Sub
err_imp:
    MsgBox Error$,  48 ,  "Import" 
    Resume Next

End Sub