VBA/Excel/Access/Word/Excel/Excel ADO
Содержание
Excel based database
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
Insert a row to a worksheet by using the SQL statement
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
Opening an Excel Spreadsheet with ADO
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
Use ADO to read the data from Access database to Excel
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