Microsoft Access: ADO Programming Code Examples
To use the ADO Library, choose References on the Tools menu in the code window, and check the box beside: Microsoft ActiveX Data Objects 2.8 Library or the latest version that you have.
| Functions |
Description |
| ImportExcelData() | Import Excel data into Access new table using ADO. |
| ImportData_ExcelObject() | Import Excel data into Access new table using Excel Object. |
| ExportAccessData_ExcelObject() | Export Access data into Excel sheet by selected fields, using Excel Object. |
| CopyAccessDataToExcel() | Export Access data into Excel sheet without using Excel Object. |
| FSOWriteLine() | Export Access table data to an external text file. |
| CreateView() | Create a new query using SQL statement and ADO Connection Execute method. |
| CreateModifyTable() | Modify a query using SQL statement. |
| CreateCommandObject() | Create Command object using CommandText |
| CommandTextUpdateProcedure() | Use CommandText property to update and execute the text of a procedure. |
| OpenSchemaExample() | List the table names. |
| DeleteRecord_ExecuteMethod() | Delete records using Execute Method (ADO Connection). |
| RecordsetOpen() | Open a recordset. |
| RecordsetFind() | Find a record based on a search string. |
| RecordsetSeek() | Find a record that matches the specified value. |
| AddRecord() | Add new records using recordset.AddNew method. |
| DeleteRecord() | Delete records using Recordset.Delete method. |
| ReplaceRecord() | Explicitly and implicitly call the Update method to change a record's value. |
| ReplaceAllRecords() | Update all records using a loop structure. |
| ShowMultipleUsers() | List the users currently connected to the database. |
Option Compare Database
' Setting the HDR
field to Yes means that the first row of the worksheet contains column
headings.
' Setting the IMEX field to 1 means that values in columns containing a
mixture of text, and numbers should be treated _
as text such as in the case of part numbers. Format Sheet1 as
[Sheet1$] so that database driver can locate worksheet name.
Sub ImportExcelData()
' Purpose:
Import data from Excel with ADO treating Excel worksheet as a database.
Dim cn As ADODB.Connection
Dim InputTbl As ADODB.Recordset
Dim OutputTbl As ADODB.Recordset
Dim fld As ADODB.Field
Dim strSql As String
Set cn = CurrentProject.Connection
Set InputTbl = New ADODB.Recordset
InputTbl.ActiveConnection =
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=D:\Planning\TSL_upload.xls;" & _
"Extended Properties=""Excel
8.0; HDR=YES; IMEX=1"""
InputTbl.Open "SELECT * FROM
[Sheet1$]", , adOpenStatic, adLockReadOnly
' or you
can use a range with a define name, or use a specific address (for
example, [Sheet1$A1:G500])
' InputTbl.Open "Select * from
[Sheet1$A1:G500]", cn, adOpenStatic
strSql = "CREATE TABLE tblTSL(Date_Changed date,
Part_Number varchar(12) not null," _
& "Std_Cost Money, Old_TSL
integer, New_TSL integer not null)"
cn.Execute strSql
Set OutputTbl = New ADODB.Recordset
OutputTbl.ActiveConnection =
CurrentProject.Connection
OutputTbl.Open "[tblTSL]", , adOpenDynamic,
adLockOptimistic
Do While Not InputTbl.EOF
OutputTbl.AddNew
For Each fld In InputTbl.Fields
OutputTbl.Fields(fld.Name).Value = fld.Value
Next fld
OutputTbl.Update
InputTbl.MoveNext
Loop
Set InputTbl = Nothing
Set OutputTbl = Nothing
End Sub
Option Compare Database
' For this example, you must
add reference to the Microsoft Excel 11.0 Object Library.
' Excel Objects runs Excel application in the background and so is
slower than using ADO to read data from Excel. If you are not _
dealing with a lot of data, this approach using Excel objects still works
fine.
Sub ImportData_ExcelObject()
' Purpose:
Import data from Excel using Excel Object library.
Dim cn As New ADODB.Connection
Dim outputTbl As ADODB.Recordset
Dim strSql As String
Dim i As Long
Dim ex As Excel.Application
Dim wb As Excel.WorkBook
Dim ws As Excel.WorkSheet
Set ex = New Excel.Application
Set wb = ex.Workbooks.Open("D:\Planning\TSL_upload.xls")
Set ws = wb.Sheets("Sheet1")
Set cn = CurrentProject.Connection
strSql = "CREATE TABLE table_TSL(Date_Changed date, Part_Number
varchar(12) not null," & _
"Std_Cost Currency, Old_TSL integer, New_TSL integer not null)"
cn.Execute strSql
Set outputTbl = New ADODB.Recordset
outputTbl.ActiveConnection = CurrentProject.Connection
outputTbl.Open "[table_TSL]", , adOpenDynamic, adLockOptimistic
i = 2
Do While ws.Cells(i, 1) <> ""
outputTbl.AddNew
outputTbl.Fields(0) = ws.Cells(i, 1)
outputTbl.Fields(1) = ws.Cells(i, 2)
outputTbl.Fields(2) = ws.Cells(i, 3)
outputTbl.Fields(3) = ws.Cells(i, 4)
outputTbl.Fields(4) = ws.Cells(i, 5)
outputTbl.Update
i = i + 1
Loop
outputTbl.Close
Set outputTbl = Nothing
Set ws = Nothing
wb.Close
Set wb = Nothing
Set ex = Nothing
End Sub
Option Compare Database
' Because Excel Objects runs Excel application in the background, taking up memory and CPU cycle, and it performs slower than _
using ADO to read data from Excel. Use this example only if you do not have huge data to work on.
' It saves the data into C:\myAccessExport.xls
Sub ExportAccessData_ExcelObject()
' Purpose:
Export data from selected table and columns to a new Excel workbook.
Dim rs As ADODB.Recordset
Dim i As Long
Dim xl As Excel.Application
Dim wb As Excel.WorkBook
Dim ws As Excel.WorkSheet
Dim col As Integer
Dim row As Long
Set rs = New ADODB.Recordset
rs.ActiveConnection = "Provider='Microsoft.Jet.OLEDB.4.0';" & _
"Data Source=C:\Program Files\Microsoft Office\OFFICE11\SAMPLES\Northwind.mdb;"
rs.Open "[Customers]", , adOpenDynamic, adLockOptimistic
Set xl = New Excel.Application
Set wb = xl.Workbooks.Add
Set ws = wb.Sheets("Sheet1")
For col = 0 To rs.Fields.Count - 1
ws.Cells(1, col + 1) = rs.Fields(col).Name
Next col
ws.Columns("G:I").Delete
' ws.Cells(1, 1) = "CustomerID"
' ws.Cells(1, 2) = "CompanyName"
' ws.Cells(1, 3) = "ContactName"
' ws.Cells(1, 4) = "ContactTitle"
' ws.Cells(1, 5) = "Address"
' ws.Cells(1, 6) = "Phone"
' ws.Cells(1, 7) = "Fax"
''' Get data from the database and insert it into the spreadsheet.
' row = 2
' Do While Not rs.EOF
' For col = 0 To rs.Fields.Count - 1
' ws.Cells(row, col + 1) = rs.Fields(col).Value
' Next col
' row = row + 1
' rs.MoveNext
' Loop
'Get data from the database and insert it into the spreadsheet.
i = 2
Do While Not rs.EOF
ws.Cells(i, 1) = rs.Fields("CustomerID")
ws.Cells(i, 2) = rs.Fields("CompanyName")
ws.Cells(i, 3) = rs.Fields("ContactName")
ws.Cells(i, 4) = rs.Fields("ContactTitle")
ws.Cells(i, 5) = rs.Fields("Address")
ws.Cells(i, 6) = rs.Fields("City")
ws.Cells(i, 7) = rs.Fields("Phone")
ws.Cells(i, 8) = rs.Fields("Fax")
' ws.Cells(i, 8) = FormatNumber(rs.Fields("Fax"), vbFalse, vbFalse, vbFalse)
rs.MoveNext
i = i + 1
Loop
rs.Close
Set rs = Nothing
Set ws = Nothing
wb.Close True, "C:\myAccessExport.xls" 'it saves into this worksheet in C:\
Set wb = Nothing
Set xl = Nothing
End Sub
Sub CopyAccessDataToExcel()
'Purpose:
of an existing Excel workbook.
Dim cn As New ADODB.Connection
Dim strConn As String
Dim copied As Long
Screen.MousePointer = vbHourglass
DoEvents
strConn = ConnectionString
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Program Files\Microsoft Office\OFFICE11\SAMPLES\Northwind.mdb;"
cn.Open strConn
cn.Execute "SELECT * INTO [Excel 8.0;" & _
"Database=C:\CustomersData.xls].[CustomersDetail] FROM Customers", copied
cn.Close
Screen.MousePointer = vbDefault
MsgBox "Copied " & copied & " records."
End Sub
' You must add reference to the Microsoft Scripting Runtime library in
order to use FSO.
Sub FSOWriteLine()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim fso As FileSystemObject
Dim txt As TextStream
Dim strConn As String
Dim strSql As String
Dim str As String
Set fso = New FileSystemObject
Set txt = fso.CreateTextFile("D:\MyData\My_Data.txt", True)
Set cn = New ADODB.Connection
strConn = ConnectionString
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=D:\MyData\Northwind.mdb;"
cn.Open strConn
strSql = "SELECT [EmployeeID], [HireDate], [HomePhone], [Extension] FROM Employees"
Set rs = New ADODB.Recordset
' rs.Open "Select EmployeeID, HireDate, HomePhone, Extension From Employees", , _
adOpenForwardOnly, adLockReadOnly
rs.Open strSql, cn
txt.WriteLine "EmployeeID, HireDate, HomePhone, Extension"
Do While Not rs.EOF
str = "" & FormatNumber(rs("EmployeeID"), vbFalse, vbFalse, vbFalse) & ", "
str = str & FormatDateTime(rs("HireDate"), vbShortDate) & ", "
str = str & rs("HomePhone") & ", "
str = str & rs("Extension")
txt.WriteLine str
rs.MoveNext
Loop
txt.Close
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
Function
CreateView()
'Purpose: Create a new
query and make-table query using SQL string and ADO Execute method.
'Run the query and
then export the table to a closed workbook.
'This example assumes
you have the sample Northwind.mdb file currently open.
'In SQL, a View is a virtual table based on the result-set of an SQL
statement. The fields in
'a View are fields from one or more real tables in the
database. You can add SQL functions,
'WHERE, and JOIN statements to a View and present the data as
if the data were coming from one
'single table. A View always shows up-to-date
data.
Dim cn As ADODB.Connection
Dim strSql As String, strQuery As String
Set cn = CurrentProject.Connection
strSql = "CREATE VIEW qry_CustomersView AS SELECT Customers.* FROM Customers " & _
"WHERE City='London'"
cn.Execute strSql 'create a query named qry_CustomersView
strSql = "SELECT DISTINCT CustomerID AS CustomerCode INTO tblMyCustomer FROM Customers"
'change the field name and create a view (make-table query) named tblMyCustomer
cn.Execute strSql
strQuery = "qry_CustomersView"
'run the query called qry_CustomersView
cn.Execute strQuery, , adCmdStoredProc
'export data from tblMyCustomer Table to a worksheet's range (note: if we don't specify
' sheet name, it will send to the default Properties Sheet1). see sample.
DoCmd.TransferSpreadsheet acExport, 8, "tblMyCustomer", "D:\MyData\TestData.xls", True
MsgBox "A query called 'qry_CustomersView' was created." & vbCrLf & _
"A new table called 'tblMyCustomer' was populated, data exported to D:\MyData\TestData.xls"
cn.Close
Set cn = Nothing
End Function
' The ALTER TABLE statement is used to add, delete, or modify
columns in an existing table.
Function CreateModifyTable()
' Purpose: Modify a table and columns using ADO and SQL string.
Dim cn As ADODB.Connection
Dim strSql As String
Set cn = CurrentProject.Connection
' Create a table
tblTEMP with 2 columns holding 15 and 5 characters length string
strSql = "CREATE TABLE tblTEMP(Employee_Name
varchar(15), Employee_ID varchar(5) not null)"
cn.Execute strSql
' Create 2
columns with date datatype
strSql = "ALTER TABLE tblTEMP ADD Date_Joined
date, Date_Registered date"
cn.Execute strSql
'
Delete off the last column
strSql = "ALTER TABLE tblTEMP DROP
Date_Registered"
cn.Execute strSql
' Populate
values to the three columns
'''strSql = "INSERT
INTO tblTEMP (Employee_Name, Employee_ID, Date_Joined) SELECT " & _
"'Bob', '12345', '12-Jan-2005' UNION ALL SELECT
'Robert', '11234', '25-Jan-2006'""
strSql = "INSERT INTO tblTEMP (Employee_Name,
Employee_ID, Date_Joined) VALUES " & _
"('Bob', 12345, '12-Jan-2005');"
cn.Execute strSql
strSql = "INSERT INTO tblTEMP (Employee_Name,
Employee_ID, Date_Joined) VALUES " & _
"('Albert', '11234', '25-Jan-2006');"
cn.Execute strSql
' Update
all occurences of Employee_Name field from 'Bob' to 'Robert'
strSql = "UPDATE tblTEMP SET Employee_Name ='"
& "Robert " & "'" & "WHERE " & _
"Employee_Name ='Bob'"
cn.Execute strSql
'''strSql = "UPDATE
tblTEMP SET Employee_Name =""Robert"" WHERE Employee_Name
=""Bob"""
' Delete
the entire record where Employee_ID is '11234'
strSql = "DELETE FROM tblTEMP WHERE
Employee_ID = ""11234"""
cn.Execute strSql
cn.Close
set cn = Nothing
End Function
Sub CreateCommandObject()
Dim rst As ADODB.Recordset
Dim cmd As ADODB.Command
'Instantiate the command object
Set cmd = New ADODB.Command
'Designate where the data comes from
cmd.CommandText = "SELECT * FROM tblClients"
'Establish the connection information
cmd.ActiveConnection = CurrentProject.Connection
'Use the execute method to return a result set into the recordset object
Set rst = cmd.Execute
'Print the RecordCount property
Debug.Print rst.RecordCount 'Prints Recordcount
'Display the resulting data
Debug.Print rst.GetString
'Close the recordset and destroy the objects
rst.Close
Set rst = Nothing
Set cmd = Nothing
End Sub
Sub CommandTextUpdateProcedure()
'Purpose:
On Error GoTo ProcedureTextError
Dim cnn As ADODB.Connection
Dim cmd As New ADODB.Command
Dim strConn As String
' Open the connection.
Set cnn = New ADODB.Connection
strConn = "Provider='Microsoft.Jet.OLEDB.4.0';" & _
"Data Source=C:\Program Files\Microsoft Office\OFFICE11\SAMPLES\Northwind.mdb;"
cnn.Open strConn
With cmd
Set cmd.ActiveConnection = cnn
' Update the CommandText.
.CommandText = "UPDATE [Products] SET [UnitPrice]=[UnitPrice]+([UnitPrice]*0.025) " & _
"WHERE [ProductName] ='Chai'"
.Execute
End With
'Clean up objects.
cnn.Close
Set cmd = Nothing
Set cnn = Nothing
Exit Sub
ProcedureTextError:
Set cmd = Nothing
If Not cnn Is Nothing Then
If cnn.State = adStateOpen Then
cnn.Close
End If
End If
Set cnn = Nothing
If Err <> 0 Then
MsgBox Err.Source & "-->" & Err.Description, , "Error"
End If
End Sub
' Besides
adding reference to the Microsoft ActiveX Data Objects 2.x Library in VBE, you must also reference to Microsoft Excel
' Object Library.
Your Access database must also be open. This simple function using ADO OpenSchema method will copy all the
' Access
table names to column A in
Sheet1 of a new workbook.
Function OpenSchemaExample()
'Purpose: List the
tables names using ADO,
copy them to Excel sheet
Dim cn As
ADODB.Connection
Dim rs As
ADODB.Recordset
Dim fld As
ADODB.Field
Dim i As
Integer
Dim xlapp As
Excel.Application, xlwb As Excel.Workbook, xlws As Excel.Worksheet
'Dim xlrng As
Excel.Range
Set cn =
CurrentProject.Connection
Set rs =
cn.OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "TABLE"))
Set xlapp =
New Excel.Application
xlapp.Visible = True
Set xlwb =
xlapp.Workbooks.Add
Set xlws =
xlwb.ActiveSheet
i = 1
' For Each fld In
rs.Fields
' xlws.Cells(1,
i).Value = fld.Name
' i = i + 1
' Next fld
' Set xlrng = xlws.Range("A2")
' xlrng.CopyFromRecordset rs
' xlws.Columns.AutoFit
Do While Not
rs.EOF
xlws.Cells(i, 1).Value = rs.Fields("TABLE_NAME").Value
i = i + 1
rs.MoveNext
Loop
rs.Close
set rs =
Nothing
cn.Close
set cn =
Nothing
End Function
Sub DeleteRecord_ExecuteMethod()
Dim
pathConn As String
' Establish the
connection to database.
pathConn = "C:\Planning\SafetyStockChangeRecord.mdb"
With New ADODB.Connection
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open pathConn
.Execute "DELETE FROM tbl_SafetyStockRecord WHERE " & _
"((Date_Changed < #1/1/2002#) AND (Part_Number like '%W'))"
End With
End Sub
Function RecordsetOpen()
'Purpose: Open a recordset using ADO,
copy to Excel sheet.
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strSql As String
Dim i As Integer
Dim xlapp As Excel.Application, xlwb As Excel.Workbook, xlws As Excel.Worksheet
cn.Open
"Provider=Microsoft.Jet.OLEDB.4.0; data source=D:\MyData\Northwind.mdb;"
strSql = "SELECT CompanyName FROM Customers"
rs.Open strSql, cn
Set xlapp = New Excel.Application
xlapp.Visible = True
Set xlwb = xlapp.Workbooks.Add
Set xlws = xlwb.ActiveSheet
i = 1
Do While Not rs.EOF
'rs.EOF and rs.BOF returns True when rs is empty.
xlws.Cells(i, 1).Value = rs!CompanyName
i = i + 1
rs.MoveNext
Loop
rs.Close
set rs = Nothing
cn.Close
set cn = Nothing
End Function
Sub
RecordsetFind(str As String)
'Purpose: Find a record based on a search string using ADO Find method.
'This example assumes
you have the sample Northwind.mdb file currently open.
Dim rs As ADODB.Recordset
Dim strSearch As String
strSearch = "City = '" & str & "'"
Set rs = New ADODB.Recordset
With rs
.Open "Customers",
CurrentProject.Connection, adOpenStatic, adLockPessimistic
.MoveFirst
'position pointer to beginning of file
.Find strSearch
Do Until .EOF
'rs.EOF and
rs.BOF returns True when rs is empty.
Debug.Print rs("Company Name")
.Find strSearch, 1
Loop
End With
rs.Close
set rs = Nothing
End Sub
'Or
in
the Immediate Window, for example, type debug.print("Glendale")
Sub runFindClients()
Dim str As String
str = "Glendale"
Call FindClients(str)
End Sub
Sub RecordsetSeek(CustomerID As Integer)
'Find company name record using ADO ADO Seek(customerID) method.
'This example assumes you have the sample Northwind.mdb file currently
open.
Dim rs As New ADODB.Recordset
With rs
.Open "Customers", CurrentProject.Connection, adOpenDynamic,
adLockOptimistic,
_
adCmdTableDirect
.Index = "PrimaryKey"
.Seek CustomerID, adSeekAfterEQ
End With
If rs.EOF Then
MsgBox "There are no records for Customer & CustomerID, vbOKOnly"
Else
MsgBox "Customer " & CustomerID & " is " & rs("Company Name"),
vbOKOnly
End If
rs.Close
set rs = Nothing
End Sub
Sub AddRecord(empID As String, fname As String,
lname As String, titl As String)
'Purpose: Add new records using ADO's AddNew method.
Dim cn As
ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConn As String
Set cn = New ADODB.Connection
strConn = ConnectionString
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=D:\MyData\Northwind.mdb;"
cn.Open strConn
Set rs = New ADODB.Recordset
With rs
.Open "Employees", cn, adOpenDynamic,
adLockOptimistic, adCmdTable
.AddNew
.Fields("EmployeeID") = empID
.Fields("LastName") = fname
.Fields("FirstName") = lname
.Fields("Title") = titl
.Update
End With
rs.Close
set rs = Nothing
cn.Close
set cn = Nothing
End Sub
'The routine
AddData() can be called by the
following code.
'Or you can type AddData "91128", "William", "Tan", "Planning Manager"
in the Immediate Window,
'and then press [Enter]. Open the table 'Employees' in D:\MyData\Northwind.mdb
to see the result.
Sub runAddRecord()
Dim empID As String, fname As String, lname As String, titl As String
empID = "91128"
fname = "William"
lname = "Tan"
titl = "Planning Manager"
Call AddData(empID, fname, lname, titl)
End Sub
'Assuming you have added the above record of
William into D:\MyData\Northwind.mdb
and you are 'currently opening that database. Now you want to
delete off William's record.
Sub DeleteRecord(empID As Long)
'Purpose: Delete a record using ADO's recordset.Delete method
Dim rs As ADODB.Recordset
Dim strSearch As String
Dim strName As String
Dim bytResponse As Byte
strSearch = "EmployeeID = " & empID
Set rs = New ADODB.Recordset
With rs
.Open "Employees", CurrentProject.Connection, adOpenDynamic,
adLockOptimistic, adCmdTable
.Find strSearch
If .EOF = True Then
MsgBox "There is no employee record for employee ID: " & empID, vbOKOnly
Exit Sub
Else
strName = rs.Fields("LastName") & " " & rs.Fields("FirstName") & " " &
rs.Fields("Title")
'message to confirm a delete action before execution
bytResponse = MsgBox("Do you want to delete the record for " _
& strName & "?", vbYesNo)
If bytResponse = vbYes Then
.Delete
End If
End If
End With
rs.Close
Set rs = Nothing
End Sub
'The routine
DeleteRecord() can be called
by this simple code.
'Or type in the Immediate Window DeleteRecord "91128"
and press [Enter].
Sub runDeleteRecord()
Dim empID As Long
empID = "91128"
DeleteRecord (empID)
End Sub
'Assuming you have added the record of
William into D:\MyData\Northwind.mdb
as in the above
'example, and you are currently opening that database.
Sub
ReplaceRecord(lname As String, LastName As String)
'Purpose: Explicitly and implicitly call Update to change a
record's value, one at a time
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
With rs
.Open "Employees", CurrentProject.Connection, adOpenDynamic,
adLockOptimistic
.Find "LastName = '" & lname & "'"
If .EOF = True Then
MsgBox "There are no matches", vbOKOnly
Exit Sub
Else
.Fields("LastName") = LastName
.MoveNext
'
this implicitly call the Update method after stating the new
value=LastName in
.Fields("LastName").
.MovePrevious
' Or alternatively, use the following syntax
which explicitly call the Update method.
'.Fields("LastName") = LastName
'.Update
' Or simply just type:
.Update "LastName", LastName
MsgBox "Replacing " & lname & " with " & LastName, vbOKOnly
End If
End With
rs.Close
set rs = Nothing
End Sub
| To move about the recordset, use these five methods: | |
| MoveFirst | Move the record pointer to the first record in the recordset. |
| MoveNext | Move the record pointer forward to the next record. |
| MovePrevious | Move the record pointer backward to the previous record. |
| MoveLast | Move the record pointer to the last record in the recordset. |
| Move | Move the record pointer a specific number of records from the current record. |
Sub
ReplaceAllRecords(ct As String, City As String)
'Purpose: implicitly call to Update in transaction to make all changes
at one time.
'Assume you are currently openning the sample Northwind.mdb
file.
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim bytResponse As Byte
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
With rs
.Open "Customers", cn, adOpenDynamic,
adLockOptimistic, adCmdTable
.Find "City = '" & ct & "'"
If .EOF = True Then
MsgBox "There are no
matches", vbOKOnly
Exit Sub
Else
cn.BeginTrans
Do Until .EOF
If .Fields("City")
= ct Then
.Fields("City") = City
Else
.MoveNext
End If
Loop
bytResponse =
MsgBox("Ready to replace City Field's all records of '" _
& ct &
"' to '" & City & "'?", vbYesNo)
If bytResponse = vbYes
Then
cn.CommitTrans
ElseIf bytResponse = vbNo
Then
cn.RollbackTrans
End If
End If
End With
rs.Close
Set rs = Nothing
End Sub
'The routine
ReplaceAllRecords() can be called
by this code.
Sub runReplaceAllRecords()
'Purpose: replace all records of city names from 'Lisboa' to 'Lisbon',
in the
'table called Customers, all at one time.
Dim ct As String, City As String
ct = "Lisboa"
City = "Lisbon"
ReplaceAllRecords(ct, City)
End Sub
| Use these three methods of the Connection objects to implement transaction processing: | |
| BeginTrans | Starts a new transaction. It can also be used to return a long value that is the level of nested transactions. |
| CommitTrans | It saves all changes made since the last BeginTrans method call, and ends the current transaction. |
| RollbackTrans | All the uncommitted changes are dumped. |
Global Const
JET_SCHEMA_USERROSTER = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
Function ShowMultipleUsers()
If you'd like to see the results, type ShowMultipleUsers in the
Immediate Window and press [Enter] to run the procedure.. Table A lists out the global constants and GUIDs
that apply to the Jet provider.
'Source: KB 198755
Dim
cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
On Error GoTo HandleErr
cn.Open
"Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=D:\MyData\Northwind.mdb"
'The user roster is exposed as a provider-specific schema rowset in the
Jet 4 OLE DB provider.
'You have to use a GUID to reference the schema, as
provider-specific schemas are not listed
'in ADO's type library for schema rowsets.
Set rs =
cn.OpenSchema(adSchemaProviderSpecific, , JET_SCHEMA_USERROSTER)
'Output the list of all users in the current database
Debug.Print
rs.Fields(0).Name, "", rs.Fields(1).Name, "", rs.Fields(2).Name,
rs.Fields(3).Name
'Debug.Print rst.GetString
While Not rs.EOF
Debug.Print rs.Fields(0), rs.Fields(1), rs.Fields(2),
rs.Fields(3)
rs.MoveNext
Wend
cnn.Close
set cn = Nothing
rs.Close
set rs = Nothing
Exit Function
HandleErr:
MsgBox "Error " & Err.Number & ": " & Err.Description
Exit Function
End Function
Table A: Jet OLE DB provider-specific constants
| Constant | GUID |
| JET_SCHEMA_USERROSTER | {947bb102-5d43-11d1-bdbf-00c04fb92675} |
| JET_SCHEMA_REPLPARTIALFILERLIST | {e2082df0-54ac-11d1-bdbb-00c04fb92675} |
| JET_SCHEMA_REPLCONFLICTTAGBLES | {e2082df2-54ac-11d1-bdbb-00c04fb92675} |
| JET_SCHEMA_ISAMSTATS | {8703b612-5d43-11d1-bdbf-00c04fb92675} |
