Sub ExcelExample() Dim r As Integer, f As Integer Dim vrecs As Variant Dim rs As ADODB.Recordset Dim cn As ADODB.Connection Dim fld As ADODB.Field Set cn = New ADODB.Connection cn.Provider = "Microsoft OLE DB Provider for ODBC Drivers" cn.ConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=C:\mydb.mdb;" cn.Open Debug.Print cn.ConnectionString Set rs = New ADODB.Recordset rs.CursorLocation = adUseClient rs.Open "SELECT * FROM Employees", cn, adOpenDynamic, adLockOptimistic For Each fld In rs.Fields Debug.Print fld.Name, Next Debug.Print vrecs = rs.GetRows(6) For r = 0 To UBound(vrecs, 1) For f = 0 To UBound(vrecs, 2) Debug.Print vrecs(f, r), Next Debug.Print Next Debug.Print "adAddNew: " & rs.Supports(adAddNew) Debug.Print "adBookmark: " & rs.Supports(adBookmark) Debug.Print "adDelete: " & rs.Supports(adDelete) Debug.Print "adFind: " & rs.Supports(adFind) Debug.Print "adUpdate: " & rs.Supports(adUpdate) Debug.Print "adMovePrevious: " & rs.Supports(adMovePrevious) rs.Close cn.Close End Sub
Public Sub WorksheetInsert() Dim Connection As ADODB.Connection Dim ConnectionString As String ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Sales.xls;" & _ "Extended Properties=Excel 8.0;" Dim SQL As String SQL = "INSERT INTO [Sales$] VALUES("VA", "On", "Computers", "Mid", 30)" Set Connection = New ADODB.Connection Call Connection.Open(ConnectionString) Call Connection.Execute(SQL, , CommandTypeEnum.adCmdText Or ExecuteOptionEnum.adExecuteNoRecords) Connection.Close Set Connection = Nothing End Sub
Sub Open_ExcelSpread() Dim conn As ADODB.Connection Set conn = New ADODB.Connection conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & CurrentProject.Path & _ "\Report.xls;" & _ "Extended Properties=Excel 8.0;" conn.Close Set conn = Nothing End Sub
Public Sub SavedQuery() Dim Field As ADODB.Field Dim Recordset As ADODB.Recordset Dim Offset As Long Const ConnectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\mydb.mdb;Persist Security Info=False" Set Recordset = New ADODB.Recordset Call Recordset.Open("[Sales By Category]", ConnectionString, _ CursorTypeEnum.adOpenForwardOnly, LockTypeEnum.adLockReadOnly, _ CommandTypeEnum.adCmdTable) If Not Recordset.EOF Then With Sheet1.Range("A1") For Each Field In Recordset.Fields .Offset(0, Offset).Value = Field.Name Offset = Offset + 1 Next Field .Resize(1, Recordset.Fields.Count).Font.Bold = True End With Call Sheet1.Range("A2").CopyFromRecordset(Recordset) Sheet1.UsedRange.EntireColumn.AutoFit Else Debug.Print "Error: No records returned." End If Recordset.Close Set Recordset = Nothing End Sub
Источник.
http://vbex.ru/index.php/VBA/Excel/Access/Word/Excel/Excel_ADO