Программа изъятия из текстового файла DOS нужных фрагментов и преобразования их в таблицу базы данных MS Access. Задачка часто встречается при использовании текстовых отчетов, созданных в DOS в качестве входных документов для приложения на VB. В этом примере кода входной файл, считываемый с дисковода A, представляет собой набор столбцов немного плавающих по ширине и содержащих цифровые значения. В отдельных строках располагаются названия объектов, которым соответствуют считываемые значения.

Private Sub mnuDriveABaza_Click()
    '---------------------------------------------------
    'Пример преобразования текстового файла DOS в базу
    'данных формата *.mdb (Access).Таблица в базе
    'создана заранее и связана с Form4.DBGrid1 по Data1
    'в дочерней форме Form4.
    'В DBGrid1 и виден результат. Недостаток - невысокое
    'быстродействие (у меня был файл ~ 5000 строк).
    '---------------------------------------------------
'Эти строки - в General основной формы
Private Declare Function GetOEMCP Lib "kernel32" () As Long
Private Declare Function GetACP Lib "kernel32" () As Long
Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
'-------------------------------------------------------
    Dim sFile, sLine As String
    Dim str, str0, str1, str2 As String
 
    With dlgCommonDialog
        'To Do
        'set the flags and attributes of the
        'common dialog control
        .Filter = "All Files (*.*)|*.*"
        .ShowOpen
        If Len(.filename) = 0 Then
            Exit Sub
        End If
        sFile = .filename
    End With
    'To Do
    'process the opened file
    FilePath$ = dlgCommonDialog.filename
    Open FilePath$ For Input As 1
    InputStr$ = Input$(LOF(1), 1)
    OutputStr$ = Space$(Len(InputStr$))
    Code& = OemToChar(InputStr$, OutputStr$)
    Close 1
    Open "c:/Program Files/Fuel/fueltemp.doc" For Output As 2
    Print #2, OutputStr$
    Close 2
    Open "c:/Program Files/Fuel/fueltemp.doc" For Input As 2
    Do While Not EOF(2)
        Line Input #2, sLine$
        If sLine = "" Then GoTo 20
        'Отфильровываю ненужные строки
        If InStr(1, sLine$, "----------", vbTextCompare) > 0 Then GoTo 20
        If InStr(1, sLine$, "иятие", vbTextCompare) > 0 Then GoTo 20
        If InStr(1, sLine$, "смена", vbTextCompare) > 0 Then GoTo 20
        If InStr(1, sLine$, "Город", vbTextCompare) > 0 Then GoTo 20
        If InStr(1, sLine$, "топлива", vbTextCompare) > 0 Then GoTo 20
        If InStr(1, sLine$, "Табельный", vbTextCompare) > 0 Then GoTo 20
        If InStr(1, sLine$, "ОПЕРАТОР", vbTextCompare) > 0 Then GoTo 20
        If InStr(1, sLine$, "БУХГАЛТЕР", vbTextCompare) > 0 Then GoTo 20
 
 
        'Проверка на подзаголовок (oн в первых позициях
        'текста) и его нужно вставлять в каждую строку
        'таблицы
        If Left(sLine$, 10) = "          " Then GoTo 10
            str3 = Mid(sLine$, 8, 7)
        'Считывание данных с конкретных позиций
10      If InStr(1, sLine$, ":", vbTextCompare) = 0 Then
            str = Mid(sLine$, 1, 130)
            str0 = Mid(sLine$, 78, 12)
            str1 = Mid(sLine$, 106, 6)
            'Убираю ненужные мне апострофы в значениях
            If InStr(2, str1, "'", vbTextCompare) > 0 Then str1 = Left(str1, InStr(2, str1, "'", vbTextCompare) - 1) + Mid(str1, InStr(2, str1, "'", vbTextCompare) + 1, 6)

            str2 = Mid(sLine$, 118, 12)
            'Убираю ненужные мне апострофы в значениях
            If InStr(2, str2, "'", vbTextCompare) > 0 Then str2 = Left(str2, InStr(2, str2, "'", vbTextCompare) - 1) + Mid(str2, InStr(2, str2, "'", vbTextCompare) + 1, 6)
            'Запись в поля таблицы
            Form4.Data1.Recordset.AddNew
            Form4.Data1.Recordset.Fields("НомерКарточки").Value = str3
            Form4.Data1.Recordset.Fields("НазваниеГСМ").Value = str0
            Form4.Data1.Recordset.Fields("КоличествоЛ").Value = str1
            Form4.Data1.Recordset.Fields("КоличествоР").Value = str2
            Form4.Data1.Recordset.Update
        End If
20  Loop
    Close 2
    Form4.Data1.Refresh
    Form4.Show
InputError:
    Exit Sub

End Sub