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