Thread: Codes For Handling Access Database ( DAO & ADO )

(From Access 2000 Client/Server Book )

Option Compare Database
Option Explicit

Sub CreateTableDAO() 'DAO Version
Dim dbsLocal As Database
Dim tdfLocal As TableDef
Dim fldLocal As Field
Dim idxLocal As Index

Set dbsLocal = CurrentDb() ' Create new TableDef.
' Add field to Table Definition
Set tdfLocal = dbsLocal.CreateTableDef("tblFoods")
Set fldLocal = tdfLocal.CreateField("FoodID", DB_TEXT, 5)
tdfLocal.Fields.Append fldLocal

Set fldLocal = tdfLocal.CreateField("Description", DB_TEXT, 25)
tdfLocal.Fields.Append fldLocal

Set fldLocal = tdfLocal.CreateField("Calories", DB_INTEGER)
tdfLocal.Fields.Append fldLocal
dbsLocal.TableDefs.Append tdfLocal

' Designate the FoodID field as the Primary Key Index
Set idxLocal = tdfLocal.CreateIndex("PrimaryKey")
Set fldLocal = idxLocal.CreateField("FoodID")
idxLocal.Primary = True
idxLocal.Unique = True
idxLocal.Fields.Append fldLocal

' Add the index to the Indexes collection
tdfLocal.Indexes.Append idxLocal
End Sub

Sub CreateTableADO() ' ADO Version
Dim cnnLocal As ADODB.Connection
Dim cmdLocal As ADODB.Command

' Create Connection @_@@_@@_@@_@@_@@_@ and open it on CHAP28.MDB
Set cnnLocal = New ADODB.Connection
cnnLocal.ConnectionString = "dsn=Chap28;UID=admin;PWD=;"
cnnLocal.Open

Set cmdLocal = New ADODB.Command
Set cmdLocal.ActiveConnection = cnnLocal
cmdLocal.CommandText = "CREATE TABLE tblFoods " _
& "(FoodID TEXT (5), Description TEXT (25), Calories INTEGER);"
cmdLocal.Execute

cmdLocal.CommandText = "CREATE UNIQUE INDEX PrimaryKey " _
& "ON tblFoods(FoodID) " _
& "WITH PRIMARY DISALLOW NULL;"
cmdLocal.Execute
End Sub

Sub DeleteTableDAO() ' DAO Version
Dim dbsLocal As Database

Set dbsLocal = CurrentDb
dbsLocal.TableDefs.Delete "tblFoods"
End Sub

Public Sub DeleteTableADO() ' ADO Version
Dim cnnLocal As ADODB.Connection
Dim cmdLocal As ADODB.Command

' Create Connection @_@@_@@_@@_@@_@@_@ and open it on CHAP28.MDB
Set cnnLocal = New ADODB.Connection

cnnLocal.ConnectionString = "dsn=Chap28;UID=admin;PWD=;"
cnnLocal.Open

Set cmdLocal = New ADODB.Command
Set cmdLocal.ActiveConnection = cnnLocal
cmdLocal.CommandText = "DROP TABLE tblFoods"
cmdLocal.Execute
End Sub

Sub CreateRelationDAO()
Dim dbsLocal As Database
Dim relLocal As Relation
Dim fldLocal As Field

Set dbsLocal = CurrentDb
Set relLocal = dbsLocal.CreateRelation()
With relLocal
.Name = "PeopleFood"
.Table = "tblFoods"
.ForeignTable = "tblPeople"
.Attributes = dbRelationDeleteCascade
End With
Set fldLocal = relLocal.CreateField("FoodID")
fldLocal.ForeignName = "FoodID"
relLocal.Fields.Append fldLocal
dbsLocal.Relations.Append relLocal
End Sub

Sub CreateQueryDAO()
Dim dbsLocal As Database
Dim qdfLocal As QueryDef
Dim strSQL As String

Set dbsLocal = CurrentDb
Set qdfLocal = dbsLocal.CreateQueryDef("qryBigProjects")
strSQL = "Select ProjectID, ProjectName, ProjectTotalEstimate " _
& "From tblProjects " _
& "Where ProjectTotalEstimate >= 30000"
qdfLocal.SQL = strSQL
End Sub


Sub IncreaseEstimateDAO() ' DAO Version
Dim dbsLocal As Database
Dim rstProjects As Recordset
Dim strSQL As String
Dim intUpdated As Integer

Set dbsLocal = CurrentDb()
Set rstProjects = dbsLocal.OpenRecordset("tblProjectsChange", dbOpenDynaset)
strSQL = "ProjectTotalEstimate < 30000"
intUpdated = 0
rstProjects.FindFirst strSQL
Do While Not rstProjects.NoMatch
intUpdated = intUpdated + 1
rstProjects.Edit
rstProjects.Fields("ProjectTotalEstimate") = _
rstProjects.Fields("ProjectTotalEstimate") * 1.1
rstProjects.Update
rstProjects.FindNext strSQL
Loop
Debug.Print intUpdated & " Records Updated"
rstProjects.Close
End Sub

Sub IncreaseEstimateADO() &#39; ADO Version
Dim cnnLocal As ADODB.Connection
Dim cmdLocal As ADODB.Command
Dim rstLocal As ADODB.Recordset
Dim intUpdated As Integer

&#39; Create Connection @_@@_@@_@@_@@_@@_@ and open it on CHAP28.MDB
Set cnnLocal = New ADODB.Connection

cnnLocal.ConnectionString = "dsn=Chap28;UID=admin;PWD=;"
cnnLocal.Open

Set cmdLocal = New ADODB.Command
Set cmdLocal.ActiveConnection = cnnLocal
cmdLocal.CommandText = "SELECT * FROM tblProjectsChange " _
& "WHERE ProjectTotalEstimate < 30000"
rstLocal.CursorType = adOpenForwardOnly
Set rstLocal = cmdLocal.Execute()

intUpdated = 0
Do While Not rstLocal.EOF
intUpdated = intUpdated + 1
rstLocal.Fields("ProjectTotalEstimate") = _
rstLocal.Fields("ProjectTotalEstimate") * 1.1
rstLocal.Update
rstLocal.MoveNext
Loop
Debug.Print intUpdated & " Records Updated"
rstLocal.Close
End Sub

Sub RunUpdateQueryDAO() &#39; DAO Version
Dim dbsLocal As Database
Dim qdfLocal As QueryDef

Set dbsLocal = CurrentDb
Set qdfLocal = dbsLocal.QueryDefs("qryIncreaseTotalEstimate")
qdfLocal.Execute
End Sub

Sub RunUpdateQueryADO() &#39; ADO Version
Dim cnnLocal As ADODB.Connection
Dim cmdLocal As ADODB.Command

&#39; Create Connection @_@@_@@_@@_@@_@@_@ and open it on CHAP28.MDB
Set cnnLocal = New ADODB.Connection
cnnLocal.ConnectionString = "dsn=Chap28;UID=admin;PWD=;"
cnnLocal.Open

Set cmdLocal = New ADODB.Command
Set cmdLocal.ActiveConnection = cnnLocal
cmdLocal.CommandText = "UPDATE tblProjectsChange " _
& "SET ProjectTotalEstimate = 30000 " _
& "WHERE ProjectTotalEstimate < 30000;"
cmdLocal.Execute
End Sub

Sub DeleteCusts(lngProjEst As Long)
Dim dbsLocal As Database
Dim rstProjects As Recordset
Dim intCounter As Integer

Set dbsLocal = CurrentDb
Set rstProjects = dbsLocal.OpenRecordset("tblProjectsChange", dbOpenDynaset)
intCounter = 0
Do While Not rstProjects.EOF
If rstProjects.Fields("ProjectTotalEstimate") < lngProjEst Then
rstProjects.Delete
intCounter = intCounter + 1
End If
rstProjects.MoveNext
Loop
Debug.Print intCounter & " Customer Records Deleted"
End Sub

Private Sub cmdAddRecordDAO_Click() &#39; DAO Recordset
Dim dbsLocal As Database
Dim rstProject As Recordset

Set dbsLocal = CurrentDb()
Set rstProject = dbsLocal.OpenRecordset("tblProjectsChange", DB_OPEN_DYNASET)
With rstProject
.AddNew
.Fields("ProjectName") = Me!txtProjectName
.Fields("ProjectDescription") = Me!txtProjectDescription
.Fields("[ClientID]") = Me!cboClientID
.Update
End With
Me!txtProjectID = rstProject!ProjectID
End Sub


Private Sub cmdAddRecordADO_Click() &#39; ADO Version
Dim cnnLocal As ADODB.Connection
Dim cmdLocal As ADODB.Command
Dim rstLocal As ADODB.Recordset

&#39; Create Connection @_@@_@@_@@_@@_@@_@ and open it on CHAP28.MDB
Set cnnLocal = New ADODB.Connection

cnnLocal.ConnectionString = "dsn=Chap28;UID=admin;PWD=;"
cnnLocal.Open

Set cmdLocal = New ADODB.Command
Set cmdLocal.ActiveConnection = cnnLocal
cmdLocal.CommandText = "SELECT * FROM tblProjectsChange"
rstLocal.CursorType = adOpenDynamic
Set rstLocal = cmdLocal.Execute()

With rstLocal
.AddNew
.Fields("ProjectName") = Me!txtProjectName
.Fields("ProjectDescription") = Me!txtProjectDescription
.Fields("[ClientID]") = Me!cboClientID
.Update
End With
Me!txtProjectID = rstLocal.Fields("ProjectID")
End Sub

Private Sub cmdLastModified_Click()
Dim dbsLocal As Database
Dim rstProject As Recordset
Set dbsLocal = CurrentDb()
Set rstProject = dbsLocal.OpenRecordset("tblProjectsChange", DB_OPEN_DYNASET)
With rstProject
.AddNew
.Fields("!ProjectName") = Me!txtProjectName
.Fields("ProjectDescription") = Me!txtProjectDescription
.Fields("[ClientID]") = Me!cboClientID
.Update
.Bookmark = rstProject.LastModified
End With
Me!txtProjectID = rstProject!ProjectID
End Sub

Sub SortRecordsetDAO() &#39; DAO Version
Dim dbsLocal As Database
Dim rstTimeCardHours As Recordset

Set dbsLocal = CurrentDb
Set rstTimeCardHours = _
dbsLocal.OpenRecordset("tblTimeCardHours", dbOpenDynaset)
Debug.Print "NOT Sorted!!!"
Do While Not rstTimeCardHours.EOF
Debug.Print rstTimeCardHours![DateWorked]
rstTimeCardHours.MoveNext
Loop
Debug.Print "Now Sorted!!!"
rstTimeCardHours.Sort = "[DateWorked]"
Set rstTimeCardHours = rstTimeCardHours.OpenRecordset
Do While Not rstTimeCardHours.EOF
Debug.Print rstTimeCardHours.Fields("DateWorked")
rstTimeCardHours.MoveNext
Loop
End Sub

Sub SortRecordsetADO() &#39; ADO Version
Dim cnnLocal As ADODB.Connection
Dim cmdLocal As ADODB.Command
Dim rstLocal As ADODB.Recordset

&#39; Create Connection @_@@_@@_@@_@@_@@_@ and open it on CHAP28.MDB
Set cnnLocal = New ADODB.Connection
cnnLocal.ConnectionString = "dsn=Chap28;UID=admin;PWD=;"
cnnLocal.Open

Set cmdLocal = New ADODB.Command
Set cmdLocal.ActiveConnection = cnnLocal

cmdLocal.CommandText = "SELECT * FROM tblTimeCardHours"
cmdLocal.Execute
rstLocal.CursorType = adOpenForwardOnly
Set rstLocal = cmdLocal.Execute()
Debug.Print "NOT Sorted!!!"
Do While Not rstLocal.EOF
Debug.Print rstLocal.Fields("DateWorked")
rstLocal.MoveNext
Loop

cmdLocal.CommandText = "SELECT * FROM tblTimeCardHours " & _
"ORDER BY DateWorked"
cmdLocal.Execute
rstLocal.CursorType = adOpenForwardOnly
Set rstLocal = cmdLocal.Execute()
Debug.Print "Now Sorted!!!"
Do While Not rstLocal.EOF
Debug.Print rstLocal.Fields("DateWorked")
rstLocal.MoveNext
Loop
End Sub


Sub FilterRecordSet()
Dim dbsLocal As Database
Dim rstTimeCardHours As Recordset

Set dbsLocal = CurrentDb
Set rstTimeCardHours = _
dbsLocal.OpenRecordset("tblTimeCardHours", dbOpenDynaset)
Debug.Print "Without Filter"
Do While Not rstTimeCardHours.EOF
Debug.Print rstTimeCardHours![DateWorked]
rstTimeCardHours.MoveNext
Loop
rstTimeCardHours.Filter = "[DateWorked] Between #1/1/95# and #1/5/95#"
Debug.Print "With Filter"
Set rstTimeCardHours = rstTimeCardHours.OpenRecordset
Do While Not rstTimeCardHours.EOF
Debug.Print rstTimeCardHours.Fields("DateWorked")
rstTimeCardHours.MoveNext
Loop
End Sub

Sub SeekProjectDAO(lngProjectID As Long)
Dim dbsLocal As Database
Dim rstProjects As Recordset

Set dbsLocal = CurrentDb()
Set rstProjects = dbsLocal.OpenRecordset("tblProjects", dbOpenTable)
rstProjects.Index = "PrimaryKey"
rstProjects.Seek "=", lngProjectID
If rstProjects.NoMatch Then
MsgBox lngProjectID & " Not Found"
Else
MsgBox lngProjectID & " Found"
End If
End Sub

Sub FindProjectDAO(lngValue As Long)
Dim dbsLocal As Database
Dim rstProjects As Recordset
Dim strSQL As String

Set dbsLocal = CurrentDb()
Set rstProjects = dbsLocal.OpenRecordset("tblProjects", dbOpenDynaset)
strSQL = "[ProjectID] = " & lngValue
rstProjects.FindFirst strSQL
If rstProjects.NoMatch Then
MsgBox lngValue & " Not Found"
Else
MsgBox lngValue & " Found"
End If
End Sub

Sub RunParameterQueryDAO(datStart As Date, _
datEnd As Date) &#39; DAO Version
Dim dbsLocal As Database
Dim qdfLocal As QueryDef
Dim rstLocal As Recordset

Set dbsLocal = CurrentDb
Set qdfLocal = dbsLocal.QueryDefs("qryBillAmountByClient")
qdfLocal.Parameters("Please Enter Start Date") = datStart
qdfLocal.Parameters("Please Enter End Date") = datEnd
Set rstLocal = qdfLocal.OpenRecordset
Do While Not rstLocal.EOF
Debug.Print rstLocal.Fields("CompanyName"), _
rstLocal.Fields("BillAmount")
rs.MoveNext
Loop
End Sub

Sub RunParameterQueryADO(datStart As Date, datEnd As Date)
Dim cnnLocal As ADODB.Connection
Dim cmdLocal As ADODB.Command
Dim rstLocal As ADODB.Recordset
Dim prsLocal As ADODB.Parameters
Dim prmLocal As ADODB.Parameter

&#39; Create Connection @_@@_@@_@@_@@_@@_@ and open it on CHAP28.MDB
Set cnnLocal = New ADODB.Connection
cnnLocal.ConnectionString = "dsn=Chap28;UID=admin;PWD=;"
cnnLocal.Open

Set cmdLocal = New ADODB.Command
Set cmdLocal.ActiveConnection = cnnLocal

cmdLocal.CommandText = "SELECT * FROM tblBillAmountByClient " & _
"ORDER BY StartDate Where StartDate > ? And EndDate < ?"

Set prmLocal = cmdLocal.CreateParameter("StartDate", adDate, adParamInput)
prmLocal.Value = datStart
cmdLocal.Parameters.Append prmLocal
Set prmLocal = cmdLocal.CreateParameter("EndDate", adDate, adParamInput)
prmLocal.Value = datEnd
cmdLocal.Parameters.Append prmLocal
Set prmLocal = Nothing

rstLocal.CursorType = adOpenForwardOnly
Set rstLocal = cmdLocal.Execute()
Do While Not rstLocal.EOF
Debug.Print rstLocal.Fields("CompanyName"), rstLocal.Fields("BillAmount")
rstLocal.MoveNext
Loop
End Sub


Sub EnumerateDBs()
Dim wksLocal As Workspace
Dim dbsLocal As Database
Dim dbsLocal1 As Database
Dim dbsLocal2 As Database

Set wksLocal = DBEngine(0)
Set dbsLocal1 = CurrentDb
Set dbsLocal2 = ws.OpenDatabase("Nwind.MDB")
For Each dbsLocal In wksLocal.Databases
Debug.Print dbsLocal.Name
Next dbsLocal
End Sub

Sub EnumerateTables()
Dim dbsLocal As Database
Dim tblLocal As TableDef

Set dbsLocal = CurrentDb
For Each tblLocal In dbsLocal.TableDefs
Debug.Print tblLocal.Name
Next tblLocal
End Sub

Sub EnumerateQueries()
Dim dbsLocal As Database
Dim qryLocal As QueryDef

Set dbsLocal = CurrentDb
For Each qryLocal In dbsLocal.QueryDefs
Debug.Print qryLocal.Name
Debug.Print qryLocal.SQL
Next qryLocal
End Sub

Sub EnumFields()
Dim dbsLocal As Database
Dim tblLocal As TableDef
Dim fldLocal As Field
Set dbsLocal = CurrentDb
For Each tblLocal In dbsLocal.TableDefs
For Each fldLocal In tblLocal.Fields
Debug.Print fldLocal.Name
Debug.Print fldLocal.Type
Next fldLocal
Next tblLocal
End Sub

Sub EnumerateParameters()
Dim dbsLocal As Database
Dim qryLocal As QueryDef
Dim prmLocal As Parameter

Set dbsLocal = CurrentDb
For Each qryLocal In dbsLocal.QueryDefs
Debug.Print "*****" & qryLocal.Name & "*****"
For Each prmLocal In qryLocal.Parameters
Debug.Print prmLocal.Name
Next prmLocal
Next qryLocal
End Sub

Sub EnumRelations()
Dim dbsLocal As Database
Dim relLocal As Relation

Set dbsLocal = CurrentDb
For Each relLocal In dbsLocal.Relations
Debug.Print relLocal.Table & " Related To: " & relLocal.ForeignTable
Next relLocal
End Sub

Sub EnumContainers()
Dim dbsLocal As Database
Dim cntLocal As Container

Set dbsLocal = CurrentDb
For Each cntLocal In dbsLocal.Containers
Debug.Print cntLocal.Name
Next cntLocal
End Sub

Sub EnumerateForms()
Dim dbsLocal As Database
Dim cntLocal As Container
Dim docLocal As Document

Set dbsLocal = CurrentDb
Set cntLocal = dbsLocal.Containers!Forms
For Each docLocal In cntLocal.Documents
Debug.Print docLocal.Name
Next docLocal
End Sub

Sub EnumerateProperties()
Dim dbsLocal As Database
Dim cntLocal As Container
Dim docLocal As Document
Dim prpLocal As Property
Set dbsLocal = CurrentDb
Set cntLocal = dbsLocal.Containers!Forms
For Each docLocal In cntLocal.Documents
Debug.Print docLocal.Name
For Each prpLocal In docLocal.Properties
Debug.Print prpLocal.Name & " = " & prpLocal.Value
Next prpLocal
Next docLocal
End Sub

Sub ReferToCurrentDB()
Dim wksLocal As Workspace
Dim dbsLocal As Database

Set wksLocal = DBEngine(0)
Set dbsLocal = wksLocal.OpenDatabase("Nwind.mdb")
Debug.Print dbsLocal.Version
End Sub

Sub UseCurrentDBFunc()
Dim dbsLocal As Database
Set dbsLocal = CurrentDb()
Debug.Print dbsLocal.Version
End Sub

Sub OpenTable()
Dim dbsInfo As Database
Dim rstClients As Recordset

Set dbsInfo = CurrentDb()
Set rstClients = dbsInfo.OpenRecordset("tblClients")
Debug.Print rstClients.Updatable
End Sub

Sub OpenDynaSet()
Dim dbsInfo As Database
Dim rstClients As Recordset

Set dbsInfo = CurrentDb()
Set rstClients = dbsInfo.OpenRecordset("tblClients", dbOpenDynaset)
Debug.Print rstClients.Updatable
End Sub

Sub OpenQuery()
Dim dbsInfo As Database
Dim rstClients As Recordset

Set dbsInfo = CurrentDb()
Set rstClients = dbsInfo.OpenRecordset("qryHoursByProject", dbOpenSnapshot)
Debug.Print rstClients.Updatable
End Sub

Sub OpenQuery2(strQryParam As String)
Dim dbsInfo As Database
Dim rstEmployees As Recordset

Set dbsInfo = CurrentDb()
Set rstEmployees = _
dbsInfo.OpenRecordset("Select * From tblStaff " & _
"Where [Employee] Like &#39;" & _
strQueryParam & "&#39;", dbOpenSnapshot)
Debug.Print rstEmployees.Updatable
End Sub

Sub OpenRecordsetArgs()
Dim dbsLocal As Database
Dim rstLocal As Recordset

Set dbsLocal = CurrentDb
Set rstLocal = _
dbsLocal.OpenRecordset("tblProjects", dbOpenDynaset, dbReadOnly)
Debug.Print rstLocal.Updatable
End Sub

Sub RecordsetMovements()
Dim dbsLocal As Database
Dim rstLocal As Recordset

Set dbsLocal = CurrentDb
Set rstLocal = dbsLocal.OpenRecordset("tblProjects", dbOpenDynaset)

Debug.Print rstLocal!ProjectID
rstLocal.MoveNext

Debug.Print rstLocal!ProjectID
rstLocal.MoveLast

Debug.Print rstLocal!ProjectID
rstLocal.MovePrevious

Debug.Print rstLocal!ProjectID
rstLocal.MoveFirst

Debug.Print rstLocal!ProjectID
rstLocal.Close
End Sub

Sub FindRstLimits()
Dim dbsLocal As Database
Dim rstClients As Recordset

Set dbsLocal = CurrentDb()
Set rstClients = dbsLocal.OpenRecordset("tblClients", dbOpenSnapshot)
Do While Not rstClients.EOF
Debug.Print rstClients![ClientID]
rstClients.MoveNext
Loop
rstClients.Close
End Sub

Sub CountRecords()
Dim dbsLocal As Database
Dim rstProjects As Recordset

Set dbsLocal = CurrentDb()
Set rstProjects = dbsLocal.OpenRecordset("tblProjects", dbOpenSnapshot)

Debug.Print rstProjects.RecordCount &#39; Prints 0 Or 1
rstProjects.MoveLast
Debug.Print rstProjects.RecordCount &#39; Prints an accurate record Count
rstProjects.Close
End Sub

Sub FindPosition(lngValue As Long)
Dim dbsLocal As Database
Dim rstProjects As Recordset
Dim strSQL As String

Set dbsLocal = CurrentDb()
Set rstProjects = dbsLocal.OpenRecordset("tblProjects", dbOpenDynaset)
strSQL = "[ProjectID] = " & lngValue
rstProjects.FindFirst strSQL
If rstProjects.NoMatch Then
MsgBox lngValue & " Not Found"
Else
Debug.Print rstProjects.AbsolutePosition
End If
End Sub

Sub UseBookMark()
Dim dbsLocal As Database
Dim rstProjects As Recordset
Dim strSQL As String
Dim vntPosition As Variant

Set dbsLocal = CurrentDb()
Set rstProjects = dbsLocal.OpenRecordset("tblProjects", dbOpenDynaset)
vntPosition = rstProjects.Bookmark
Do Until rstProjects.EOF
Debug.Print rstProjects!ProjectID
rstProjects.MoveNext
Loop
rstProjects.Bookmark = vntPosition
Debug.Print rstProjects!ProjectID
End Sub

Private Sub cmdFindClient_Click()
Me.RecordsetClone.FindFirst "ClientID = " & Me!txtClientID
If Me.RecordsetClone.NoMatch Then
MsgBox Me!txtClientID & " Not Found"
Else
Me.Bookmark = Me.RecordsetClone.Bookmark
End If
End Sub
Sub ListAllDB@_@@_@@_@@_@@_@@_@s()
Dim dbsLocal As Database
Dim conLocal As Container
Dim docLocal As Document

Set dbsLocal = CurrentDb
For Each conLocal In dbsLocal.Containers
Debug.Print "*** " & conLocal.Name & " ***"
For Each docLocal In conLocal.Documents
Debug.Print docLocal.Name
Next docLocal
Next conLocal
End Sub

Public Sub PropsAndAttribs()
Dim cnn1 As ADODB.Connection
Dim rstEmployees As ADODB.Recordset
Dim fldLoop As ADODB.Field
Dim proLoop As ADODB.Property
Dim strCnn As String

&#39; Open connection and recordset.
strCnn = "driver={SQL Server};" & _
"server=HomeServ;uid=lmk;pwd=pwd;database=ServSamp "

cnn1.Open strCnn
Set rstEmployees = New ADODB.Recordset
rstEmployees.Open "employee", cnn1, , , adCmdTable

&#39; Display the attributes of the Employee table&#39;s properties.
Debug.Print "Property attributes:"
For Each proLoop In rstEmployees.Properties
Debug.Print " " & proLoop.Name & " = " & _
proLoop.Attributes
Next proLoop
rstEmployees.Close
cnn1.Close
End Sub

Public Sub OpenRecordsetADO()
Dim cnn1 As Connection
Dim rstEmployees As Recordset
Dim strCnn As String

&#39; Open connection.
strCnn = "driver={SQL Server};" & _
"server=HomeServ;uid=lmk;pwd=pwd;database=ServSamp "
Set cnn1 = New Connection
cnn1.Open strCnn

&#39; Open employee table.
Set rstEmployees = New Recordset
rstEmployees.CursorType = adOpenKeyset
rstEmployees.LockType = adLockOptimistic
rstEmployees.Open "employee", cnn1, , , adCmdTable
End Sub