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