Вот таким монстром вставлял, тут часть кода имена таблиц вытаскивает из БД, оставил на всяк случай авось пригодится
Для работы кода нужно подключить библиотеки (см. рисунок)
Код |
---|
Sub iAccessConnection()
' -----------------------------
Dim iConnection As ADODB.Connection
Dim iRecordset As ADODB.Recordset
Dim objADOX As ADOX.Catalog, objTable As Object
Dim iPath$, iSelect$, cnct$, i%, FieldName$, iValue$
' -----------------------------
Set iConnection = New ADODB.Connection
Set iRecordset = New ADODB.Recordset
Set objADOX = New ADOX.Catalog
iPath = ThisWorkbook.Path & Application.PathSeparator
cnct = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & iPath & "Источник БД Access.accdb"
iConnection.ConnectionString = cnct
iConnection.Open
' objADOX.ActiveConnection = iConnection.ConnectionString
' For Each objTable In objADOX.Tables
' i = i + 1
' Cells(i, 1) = objTable.Name
' Next objTable
iSelect = "Select * From OPROS1"
With frmTest
iValue = Join(Array(.txtFamiliya.Value, .txtImya.Value, .txtOtchestvo.Value, _
.CombPodrazd.Value, .chbVO.Value), "','")
iValue = "'" & iValue & "'"
End With
With iRecordset
.Open iSelect, iConnection
For i = 2 To .Fields.Count
Cells(1, i) = .Fields(i - 1).Name
FieldName = FieldName & .Fields(i - 1).Name & ","
Next i
FieldName = Left(FieldName, Len(FieldName) - 1)
iSelect = "Insert Into OPROS1 (" & FieldName & ") Values (" & iValue & ")"
Range("a2").CopyFromRecordset iRecordset
.Close
.Open iSelect, iConnection
End With
End Sub
|