Public Sub Main()
    Const sPathIn As String = "C:\Temp\"
    Const sPathOut As String = "C:\Temp\"
    Const sFileIn As String = "File.txt"
    Const sFileOut As String = "NewFile.txt"

    Dim cn As New ADODB.Connection, r As New ADODB.Recordset, _
        s As String, ss As String, sSchemaIni As String, i As Integer

    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & sPathIn & ";" & _
          "Extended Properties=Text"

    ' Создадим файл откуда берем данные для теста
    For i =  0  To  100 
        s = Mid$(Format$(Rnd, ".0000000"),  2 )
        ss = ss & Mid$(s,  1 ,  1 ) & "," & Mid$(s,  2 ,  1 ) & "," & Mid$(s,  3 ,  1 ) & "." & CInt(Mid$(s,  4 ,  3 )) & "," & Mid$(s,  7 ,  1 ) & vbCrLf
    Next i
    s = sPathOut & sFileIn
    If FileExists(s) Then Kill s
    SaveFile s, ss
    
    ' Удалим выходной файл
    s = sPathOut & sFileOut
    If FileExists(s) Then Kill s
    
    ' Создадим schema.ini
    sSchemaIni = sPathOut & "schema.ini"
    If FileExists(sSchemaIni) Then Kill sSchemaIni
    ss = "[File.txt]" & vbCrLf _
        & "ColNameHeader=False" & vbCrLf _
        & "CharacterSet=1251" & vbCrLf _
        & "Format=Delimited(,)" & vbCrLf _
        & "DecimalSymbol=." & vbCrLf _
        & "Col1=F1 Integer" & vbCrLf _
        & "Col2=F2 Integer" & vbCrLf _
        & "Col3=F3 Float" & vbCrLf _
        & "Col4=F4 Integer" & vbCrLf _
        & vbCrLf _
        & "[NewFile.txt]" & vbCrLf _
        & "ColNameHeader=False" & vbCrLf _
        & "CharacterSet=1251" & vbCrLf _
        & "Format=Delimited(,)" & vbCrLf _
        & "DecimalSymbol=." & vbCrLf _
        & "NumberDigits=4" & vbCrLf _
        & "Col1=F1 Integer" & vbCrLf _
        & "Col2=F2 Integer" & vbCrLf _
        & "Col3=F3 Float" & vbCrLf _
        & "Col4=F4 Integer" & vbCrLf
        
    SaveFile sSchemaIni, ss
    
    ' Импортируем данные
    On Error GoTo Err_
    r.Open "SELECT * INTO [" & sFileOut _
                    & "] IN '" & sPathOut & "' [Text;] " _
            & "FROM [" & sFileIn _
            & "] ORDER BY 1,2,3,4", cn, _
                    adOpenStatic, adLockReadOnly, adCmdText
    If FileExists(sSchemaIni) Then Kill sSchemaIni
    Exit Sub

Err_:
    With cn.Errors( 0 )
        If .NativeError = - 329323426  And .Number = - 2147467259  Then Resume Next
    End With
    MsgBox Err.Description, vbCritical
End Sub

Private Function FileExists(sFile As String) As Boolean
    On Error Resume Next
    FileExists = ((GetAttr(sFile) And vbDirectory) =  0 )
    If Err.Number Then Err.Clear
End Function

Private Sub SaveFile(sFile As String, sText As String)
    Dim iHFile As Integer
    
    iHFile = FreeFile
    Open sFile For Binary As #iHFile
    Put iHFile, , sText
    Close #iHFile
End Sub