Koyote23 » 03.09.2003 (Ср) 11:01
Private Sub CopyRecords(TBLName As String)
Dim i, j As Integer
Dim InsText
Dim FLDName As String
Dim iFields As Integer, iRecords As Integer
Dim tmp As Variant
Dim arr() As String
If Left(TBLName, 5) <> "Sheet" Then
'создаём табличку в базе с нужным именем
Set Td = Db.CreateTableDef(TBLName)
i = 1
'создаём поля в табличке с нужным именем
While objExlSht.Cells(1, i).Value <> ""
FLDName = objExlSht.Cells(1, i).Value
Set Fl = Td.CreateField(FLDName, dbText)
Td.Fields.Append Fl
i = i + 1
Wend
Db.TableDefs.Append Td
'пишем в поля значения строк
ReDim arr(Td.Fields.Count - 1)
For tmp = 0 To Td.Fields.Count - 1
arr(tmp) = Td.Fields(tmp).Name
Next tmp
j = 1
Set Rs = Db.OpenRecordset(Td.Name, dbOpenTable)
While objExlSht.Cells(j + 1, 1).Value <> vbNullString
Rs.AddNew
For i = 0 To UBound(arr)
InsText = CStr(objExlSht.Cells(j + 1, i + 1).Value)
If CStr(InsText) <> vbNullString Then
'пишем в поле с именем arr(i) значение InsText
Rs(arr(i)) = InsText
End If
Next i
Rs.Update
Form1.StatusBar1.Panels(1).Text = "Proceed Table " & Td.Name & " at Rows at " & j
j = j + 1
Wend
Rs.Close
End If
End Sub
- Вложения
-
- peregonzhik.zip
- Попробуй это
как - то делал
- (4.52 Кб) Скачиваний: 78