Как импортировать строки текстового файла в столбцы таблицы

Namik

Доброго Вам времени сутокУважаемые господапри наличии времени прошу Вас помочь примероместь текстовый файл с нижеуказанным содержимым--------------------------------------------1Период энеолита заменил период бронзы:2начиная с конца VI тысячелетия до н.э.3начиная с конца II тысячелетия до н.э.4начиная с конца III тысячелетия до н.э.5начиная с конца IV тысячелетия до н.э.6начиная с конца XI тысячелетия до н.э./1Период бронзы продолжался до:2конца I тысячелетия до н.э.3конца VII тысячелетия до н.э.4конца III тысячелетия до н.э.5конца VIII тысячелетия до н.э.6конца II тысячелетия до н.э.----------------------------------------------есть база данных с таблицей testтаблица содержит 6 столбцовподскажите пожалуйстакак можно сделать так чтобыпри нажатии на кнопкупервая строка файла села в поле таблицы1 вторая в поле таблицы2 и так до символа разделителя "/"после разделителя все начинается зановоя понимаю что это реализовывается через циклно вот сам код импортирования строк в таблицы я не знаюС Уважением и БлагодарностьюНамик
9 ответов

Namik

> Автор: Namik> при наличии времени прошу Вас помочь примеромАлгоритм:устанавливаем счетчик полей таблицы в 1открываем таблицуоткрываем файлпока не конец файла, читаем строку если прочитанная строка содержит "/", тогда устанавливаем счетчик полей таблицы в 1 иначе помещаем содержимое прочитанной строки в поле таблицы, в соответствии со счетчиком полей и увеличиваем счетчик полей на 1конец показакрываем файлзакрываем таблицу


Namik

в двух циклах - нагляднее
Option Base <b>1</b>

Private Type table6
 pole1 As String
 pole2 As String
 pole3 As String
 pole4 As String
 pole5 As String
 pole6 As String
End Type
Private Sub Command1_Click()
On Error GoTo err1

Dim buf As String
Dim t() As table6

Dim rFF As Integer: rFF = FreeFile

Open "C:\TEXT.TXT" For Input As #rFF

Dim i As Byte, z As Long
i = <b>0</b>
z = <b>1</b>

Do Until EOF(rFF)
 i = i + <b>1</b>
 ReDim Preserve t(z)
 Line Input #rFF, buf
 If InStr(<b>1</b>, buf, "/") > <b>0</b> Then
 i = <b>0</b>
 z = z + <b>1</b>
 End If
 Select Case i
 Case <b>1</b>: t(z).pole1 = buf
 Case <b>2</b>: t(z).pole2 = buf
 Case <b>3</b>: t(z).pole3 = buf
 Case <b>4</b>: t(z).pole4 = buf
 Case <b>5</b>: t(z).pole5 = buf
 Case <b>6</b>: t(z).pole6 = buf
 End Select
Loop
Close #rFF
'допустим есть база db1.mdb и в ней есть шесть таблиц
Dim file_mdb As String: file_mdb = App.Path & "\db1.mdb"
Dim conn As ADODB.Connection: Set conn = New ADODB.Connection
Dim rst1 As ADODB.Recordset: Set rst1 = New ADODB.Recordset
Dim rst2 As ADODB.Recordset: Set rst2 = New ADODB.Recordset
Dim rst3 As ADODB.Recordset: Set rst3 = New ADODB.Recordset
Dim rst4 As ADODB.Recordset: Set rst4 = New ADODB.Recordset
Dim rst5 As ADODB.Recordset: Set rst5 = New ADODB.Recordset
Dim rst6 As ADODB.Recordset: Set rst6 = New ADODB.Recordset
 
conn.Provider = "Microsoft.Jet.OLEDB.4.0" ' Microsoft ActiveX Data Objects 2.7 Library
conn.Open file_mdb, "Admin" ', password

rst1.Open "Таблица1", conn, adOpenDynamic, adLockOptimistic
rst2.Open "Таблица2", conn, adOpenDynamic, adLockOptimistic
rst3.Open "Таблица3", conn, adOpenDynamic, adLockOptimistic
rst4.Open "Таблица4", conn, adOpenDynamic, adLockOptimistic
rst5.Open "Таблица5", conn, adOpenDynamic, adLockOptimistic
rst6.Open "Таблица6", conn, adOpenDynamic, adLockOptimistic

i = <b>0</b>
For z = <b>1</b> To UBound(t)
 For i = <b>1</b> To <b>6</b>
 Select Case i
 Case <b>1</b>: rst1.AddNew: rst1.Fields(<b>0</b>) = t(z).pole1: rst1.Update
 Case <b>2</b>: rst2.AddNew: rst2.Fields(<b>0</b>) = t(z).pole2: rst2.Update
 Case <b>3</b>: rst3.AddNew: rst3.Fields(<b>0</b>) = t(z).pole3: rst3.Update
 Case <b>4</b>: rst4.AddNew: rst4.Fields(<b>0</b>) = t(z).pole4: rst4.Update
 Case <b>5</b>: rst5.AddNew: rst5.Fields(<b>0</b>) = t(z).pole5: rst5.Update
 Case <b>6</b>: rst6.AddNew: rst6.Fields(<b>0</b>) = t(z).pole6: rst6.Update
 End Select
 Next
Next

err1:
 If Err.Number <> <b>0</b> Then
 MsgBox Err.Description
 End If
 On Error Resume Next
 rst1.Close: Set rst1 = Nothing
 rst2.Close: Set rst2 = Nothing
 rst3.Close: Set rst3 = Nothing
 rst4.Close: Set rst4 = Nothing
 rst5.Close: Set rst5 = Nothing
 rst6.Close: Set rst6 = Nothing
 conn.Close: Set conn = Nothing
 Close
 Err = <b>0</b>
End Sub


Namik

первый цикл надо переделать, чуть чуть, просто что бы не было лишних действий
Private Sub Command1_Click()
On Error GoTo err1

Dim buf As String
Dim t() As table6

Dim rFF As Integer: rFF = FreeFile

Open "C:\TEXT.TXT" For Input As #rFF

Dim i As Byte, z As Long
i = <b>0</b>
z = <b>1</b>

ReDim Preserve t(z)

Do Until EOF(rFF)
 i = i + <b>1</b>
 Line Input #rFF, buf
 If InStr(<b>1</b>, buf, "/") > <b>0</b> Then
 i = <b>0</b>
 z = z + <b>1</b>
 ReDim Preserve t(z)
 End If
 Select Case i
 Case <b>1</b>: t(z).pole1 = buf
 Case <b>2</b>: t(z).pole2 = buf
 Case <b>3</b>: t(z).pole3 = buf
 Case <b>4</b>: t(z).pole4 = buf
 Case <b>5</b>: t(z).pole5 = buf
 Case <b>6</b>: t(z).pole6 = buf
 End Select
Loop
Close #rFF


Namik

Благодарю Вас за ответыКленя пытаюсь использовать Ваш примероднако происходит ошибка с указанием на Dim t() As table6сообщение User-defined Type not definedи еще у меня всего одна таблица в базе но в этой таблице 6 столбцовесли я правильно понимаю то в Вашем примере надо удалить---------------------------- вот этоrst2.Open "Таблица2", conn, adOpenDynamic, adLockOptimisticrst3.Open "Таблица3", conn, adOpenDynamic, adLockOptimisticrst4.Open "Таблица4", conn, adOpenDynamic, adLockOptimisticrst5.Open "Таблица5", conn, adOpenDynamic, adLockOptimisticrst6.Open "Таблица6", conn, adOpenDynamic, adLockOptimistic----------------------------и это изменитьCase 1: rst1.AddNew: rst1.Fields(1) = t(z).pole1: rst1.UpdateCase 2: rst1.AddNew: rst2.Fields(2) = t(z).pole2: rst2.UpdateCase 3: rst1.AddNew: rst3.Fields(3) = t(z).pole3: rst3.UpdateCase 4: rst1.AddNew: rst4.Fields(4) = t(z).pole4: rst4.UpdateCase 5: rst1.AddNew: rst5.Fields(5) = t(z).pole5: rst5.UpdateCase 6: rst1.AddNew: rst6.Fields(6) = t(z).pole6: rst6.Updateили я все перепуталС Уважением и БлагодарностьюНамик


Namik

эта строка должна быть в начале модуля формы
Option Base <b>1</b>
эти строки должны быть перед процедурами (в данном случае после Option Base)
Private Type table6
 pole1 As String
 pole2 As String
 pole3 As String
 pole4 As String
 pole5 As String
 pole6 As String
End Type
правда, смешно, я не знаю почему мне так показалось, что аж 6 таблицВы правильно написали, что надо удалить и что исправить, если первое поле таблицы какой-нибудь ключ "ID_ ".А если такого ключа нет, то начинайте с нулевого поля Fields(0). "Option Base 1" не влияет на метод Fields.Я честно говоря, надеюсь, кто-нибудь поправит код или выложит свой вариант, как более компактный.


Namik

Благодарю Вас за помощьу меня был вот такой пример (может Вам это будет интересно)----------------------------------------------------- strSQL = "SELECT * FROM fio"Set db = OpenDatabase("nam1.mdb") Set rs = db.OpenRecordset(strSQL)strSQL = "Delete From fio"db.Execute strSQL Open FileName() For Binary As #1 txt = Space(LOF(1)) Get #1, , txt Close #1rows = Split(txt, vbCrLf)For i = 0 To UBound(rows)cols = Split(rows(i), vbCrLf)If rows(i) = "/" ThenMsgBox "1"End Ifrs.AddNewFor j = 0 To rows(i) = "/"rs(j) = cols(j)Nextrs.UpdateNextrs.Closedb.CloseSet rs = NothingSet db = Nothing--------------------------------------------------но в как Вы видите в даном примере строки вводимые в столбцы таблицы идудт через пробелтекст-для-столбца1 текст-для-столбца2 текст-для-столбца3 текст-для-столбца1 текст-для-столбца2 текст-для-столбца3текст-для-столбца1 текст-для-столбца2 текст-для-столбца3текст-для-столбца1 текст-для-столбца2 текст-для-столбца3сколько пробелов столько и столбцовблагодарю Вас за ваш примерС Уважением и БлагодарностьюНамик


Namik

Option Explicit
Пример загрузки текстового файла приведенного автором ветки в Recordset:

Public Sub Main()
 Dim cn As New ADODB.Connection, r As New ADODB.Recordset
 
 cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
 "Data Source=""" & App.Path & """;" & _
 "Extended Properties=Text"

 r.Open "SELECT * FROM File.txt", cn
 Do Until r.EOF
 Debug.Print r(<b>0</b>).Name & ": " & r(<b>0</b>), r(<b>1</b>).Name & ": " & r(<b>1</b>)
 r.MoveNext
 Loop
End Sub
Ну и содержание файла schema.ini:
[File.txt]ColNameHeader=FalseCharacterSet=1251Format=FixedLengthCol1=Номер Text Width 1Col2=Вопрос Text Width 50
Проект с примером - приложен... cкачать


Namik

Ну а вставка в другую таблицу - оформить SELECT с INTO ...Циклы, Split-ы и подобная дребедень тут даром не нужны ;)


Namik

понялБольшое Вам спасибоБлагодарю всех за помощь и направлениеС уважениемНамик