adomthx1.doc

#$>A TAddNew Method Example

This example uses the AddNew method to create a new record with the specified name.

Public Sub AddNewX()

Dim cnn1 As ADODB.Connection

Dim rstEmployees As ADODB.Recordset

Dim strCnn As String

Dim strID As String

Dim strFirstName As String

Dim strLastName As String

Dim booRecordAdded As Boolean

' Open a connection.

Set cnn1 = New ADODB.Connection

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

cnn1.Open strCnn

' Open Employee table.

Set rstEmployees = New ADODB.Recordset

rstEmployees.CursorType = adOpenKeyset

rstEmployees.LockType = adLockOptimistic

rstEmployees.Open "employee", cnn1, , , adCmdTable

' Get data from the user.

strID = Trim(InputBox("Enter employee ID:"))

strFirstName = Trim(InputBox("Enter first name:"))

strLastName = Trim(InputBox("Enter last name:"))

' Proceed only if the user actually entered something

' for both the first and last names.

If (strID <> "") And (strFirstName <> "") _

And (strLastName <> "") Then

rstEmployees.AddNew

rstEmployees!emp_id = strID

rstEmployees!fname = strFirstName

rstEmployees!lname = strLastName

rstEmployees.Update

booRecordAdded = True

' Show the newly added data.

MsgBox "New record: " & rstEmployees!emp_id & " " & _

rstEmployees!fname & " " & rstEmployees!lname

Else

MsgBox "Please enter an employee ID, " & _

"first name, and last name."

End If

' Delete the new record because this is a demonstration.

cnn1.Execute "DELETE FROM employee WHERE emp_id = '" & strID & "'"

rstEmployees.Close

cnn1.Close

End Sub

VBScript Version

The following is the same example written in VBScript to be used in an Active Server Page (ASP). To view this fully functional example, you need to create a system Data Source Name (DSN) called AdvWorks using the data source AdvWorks.mdb installed with IIS and located at C:\InetPub\ASPSamp\AdvWorks. This is a Microsoft Access database file. Use Find to locate the file adovbs.inc and place it in the directory you plan to use. Cut and paste the following code to Notepad or another text editor and save it as AddNew.asp. You can view the result in any client browser.

To exercise the example, add a new fictional record in the HTML Form. Click the Add New Button. See the Delete method example to remove unwanted records.

<% Language = VBScript %>

<HTML><HEAD><TITLE>ADO 1.5 Open Method</TITLE>

</HEAD><BODY>

<Center><H3>ADO AddNew Method</H3>

'Create and Open Connection Object

Set OBJdbConnection = Server.CreateObject("ADODB.Connection")

OBJdbConnection.Open "AdvWorks"

'Create and Open Recordset Object

Set RsCustomerList = Server.CreateObject("ADODB.Recordset")

RsCustomerList.ActiveConnection = OBJdbConnection

RsCustomerList.CursorType = adOpenKeyset

RsCustomerList.LockType = adLockOptimistic

RsCustomerList.Source = "Customers"

RsCustomerList.Open

<!-- If this is first time page is open, Form collection will be empty when data is entered

run AddNew method-->

<% If Not IsEmpty(Request.Form) Then

If Not Request.Form("CompanyName") = "" Then

RsCustomerList.AddNew

RsCustomerList("CompanyName") = Request.Form("CompanyName")

RsCustomerList("ContactLastName") = Request.Form("LastName")

RsCustomerList("ContactFirstName") = Request.Form("FirstName")

RsCustomerList("PhoneNumber") = Request.Form("PhoneNumber")

RsCustomerList("City") = Request.Form("City")

RsCustomerList("StateOrProvince") = Request.Form("State")

RsCustomerList.Update

RsCustomerList.MoveFirst

End If

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Company Name</FONT></TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Contact Name</FONT></TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Phone Number</FONT></TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>State/Province</FONT></TD></TR>

<% Do While Not RsCustomerList.EOF %>

<%= RSCustomerList("CompanyName")%>

</FONT></TD>

<%= RScustomerList("ContactLastName") & ", " %>

<%= RScustomerList("ContactFirstName") %>

</FONT></TD>

<%= RScustomerList("PhoneNumber")%>

</FONT></TD>

<%= RScustomerList("City")%>

</FONT></TD>

<%= RScustomerList("StateOrProvince")%>

</FONT></TD></TR>

RScustomerList.MoveNext

Loop

</TABLE><HR>

<Table>

<TR><TD><P>Company Name:</TD>

<TR><TD><P>Contact First Name:</TD>

<TR><TD><P>Contact Last Name:</TD>

<TR><TD><P>Contact Phone:</TD>

<TR><TD><P>State / Province:</TD>

</Form></Table></Center></FONT>

<%'Show location of DSN data source

Response.Write(OBJdbConnection)

Sub Form_OnSubmit

MsgBox "Sending New Record to Server",,"ADO-ASP _Example"

End Sub

</Script>

</BODY></HTML>

#$>A TAppend and CreateParameter Methods Example

This example uses the Append and CreateParameter methods to execute a stored procedure with an input parameter.

Public Sub AppendX()

Dim cnn1 As ADODB.Connection

Dim cmdByRoyalty As ADODB.Command

Dim prmByRoyalty As ADODB.Parameter

Dim rstByRoyalty As ADODB.Recordset

Dim rstAuthors As ADODB.Recordset

Dim intRoyalty As Integer

Dim strAuthorID As String

Dim strCnn As String

' Open connection.

Set cnn1 = New ADODB.Connection

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

cnn1.Open strCnn

cnn1.CursorLocation = adUseClient

' Open command object with one parameter.

Set cmdByRoyalty = New ADODB.Command

cmdByRoyalty.CommandText = "byroyalty"

cmdByRoyalty.CommandType = adCmdStoredProc

' Get parameter value and append parameter.

intRoyalty = Trim(InputBox("Enter royalty:"))

Set prmByRoyalty = cmdByRoyalty.CreateParameter("percentage", _

adInteger, adParamInput)

cmdByRoyalty.Parameters.Append prmByRoyalty

prmByRoyalty.Value = intRoyalty

' Create recordset by executing the command.

Set cmdByRoyalty.ActiveConnection = cnn1

Set rstByRoyalty = cmdByRoyalty.Execute

' Open the Authors table to get author names for display.

Set rstAuthors = New ADODB.Recordset

rstAuthors.Open "authors", cnn1, , , adCmdTable

' Print current data in the recordset, adding

' author names from Authors table.

Debug.Print "Authors with " & intRoyalty & " percent royalty"

Do While Not rstByRoyalty.EOF

strAuthorID = rstByRoyalty!au_id

Debug.Print " " & rstByRoyalty!au_id & ", ";

rstAuthors.Filter = "au_id = '" & strAuthorID & "'"

Debug.Print rstAuthors!au_fname & " " & rstAuthors!au_lname

rstByRoyalty.MoveNext

Loop

rstByRoyalty.Close

rstAuthors.Close

cnn1.Close

End Sub

#$>A TAppendChunk and GetChunk Methods Example

This example uses the AppendChunk and GetChunk methods to fill an image field with data from another record.

Public Sub AppendChunkX()

Dim cnn1 As ADODB.Connection

Dim rstPubInfo As ADODB.Recordset

Dim strCnn As String

Dim strPubID As String

Dim strPRInfo As String

Dim lngOffset As Long

Dim lngLogoSize As Long

Dim varLogo As Variant

Dim varChunk As Variant

Const conChunkSize = 100

' Open a connection.

Set cnn1 = New ADODB.Connection

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

cnn1.Open strCnn

' Open the pub_info table.

Set rstPubInfo = New ADODB.Recordset

rstPubInfo.CursorType = adOpenKeyset

rstPubInfo.LockType = adLockOptimistic

rstPubInfo.Open "pub_info", cnn1, , , adCmdTable

' Prompt for a logo to copy.

strMsg = "Available logos are : " & vbCr & vbCr

Do While Not rstPubInfo.EOF

strMsg = strMsg & rstPubInfo!pub_id & vbCr & _

Left(rstPubInfo!pr_info, InStr(rstPubInfo!pr_info, ",") - 1) & _

vbCr & vbCr

rstPubInfo.MoveNext

Loop

strMsg = strMsg & "Enter the ID of a logo to copy:"

strPubID = InputBox(strMsg)

' Copy the logo to a variable in chunks.

rstPubInfo.Filter = "pub_id = '" & strPubID & "'"

lngLogoSize = rstPubInfo!logo.ActualSize

Do While lngOffset < lngLogoSize

varChunk = rstPubInfo!logo.GetChunk(conChunkSize)

varLogo = varLogo & varChunk

lngOffset = lngOffset + conChunkSize

Loop

' Get data from the user.

strPubID = Trim(InputBox("Enter a new pub ID:"))

strPRInfo = Trim(InputBox("Enter descriptive text:"))

' Add a new record, copying the logo in chunks.

rstPubInfo.AddNew

rstPubInfo!pub_id = strPubID

rstPubInfo!pr_info = strPRInfo

lngOffset = 0 ' Reset offset.

Do While lngOffset < lngLogoSize

varChunk = LeftB(RightB(varLogo, lngLogoSize - lngOffset), _

conChunkSize)

rstPubInfo!logo.AppendChunk varChunk

lngOffset = lngOffset + conChunkSize

Loop

rstPubInfo.Update

' Show the newly added data.

MsgBox "New record: " & rstPubInfo!pub_id & vbCr & _

"Description: " & rstPubInfo!pr_info & vbCr & _

"Logo size: " & rstPubInfo!logo.ActualSize

' Delete new record because this is a demonstration.

rstPubInfo.Requery

cnn1.Execute "DELETE FROM pub_info " & _

"WHERE pub_id = '" & strPubID & "'"

rstPubInfo.Close

cnn1.Close

End Sub

#$>A TBeginTrans, CommitTrans, and RollbackTrans Methods Example

This example changes the book type of all psychology books in the Titles table of the database. After the BeginTrans method starts a transaction that isolates all the changes made to the Titles table, the CommitTrans method saves the changes. Notice that you can use the Rollback method to undo changes that you saved using the Update method.

Public Sub BeginTransX()

Dim cnn1 As ADODB.Connection

Dim rstTitles As ADODB.Recordset

Dim strCnn As String

Dim strTitle As String

Dim strMessage As String

' Open connection.

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

Set cnn1 = New ADODB.Connection

cnn1.Open strCnn

' Open titles table.

Set rstTitles = New ADODB.Recordset

rstTitles.CursorType = adOpenDynamic

rstTitles.LockType = adLockPessimistic

rstTitles.Open "titles", cnn1, , , adCmdTable

rstTitles.MoveFirst

cnn1.BeginTrans

' Loop through recordset and ask user if she wants

' to change the type for a specified title.

Do Until rstTitles.EOF

If Trim(rstTitles!Type) = "psychology" Then

strTitle = rstTitles!Title

strMessage = "Title: " & strTitle & vbCr & _

"Change type to self help?"

' Change the title for the specified

' employee.

If MsgBox(strMessage, vbYesNo) = vbYes Then

rstTitles!Type = "self_help"

rstTitles.Update

End If

rstTitles.MoveNext

Loop

' Ask if the user wants to commit to all the

' changes made above.

If MsgBox("Save all changes?", vbYesNo) = vbYes Then

cnn1.CommitTrans

Else

cnn1.RollbackTrans

End If

' Print current data in recordset.

rstTitles.Requery

rstTitles.MoveFirst

Do While Not rstTitles.EOF

Debug.Print rstTitles!Title & " - " & rstTitles!Type

rstTitles.MoveNext

Loop

' Restore original data because this

' is a demonstration.

rstTitles.MoveFirst

Do Until rstTitles.EOF

If Trim(rstTitles!Type) = "self_help" Then

rstTitles!Type = "psychology"

rstTitles.Update

End If

rstTitles.MoveNext

Loop

rstTitles.Close

cnn1.Close

End Sub

#$>A TClone Method Example

This example uses the Clone method to create copies of a Recordset and then lets the user position the record pointer of each copy independently.

Public Sub CloneX()

Dim arstStores(1 To 3) As ADODB.Recordset

Dim intLoop As Integer

Dim strSQL As String

Dim strCnn As String

Dim strMessage As String

Dim strFind As String

' Assign SQL statement and connection string to variables.

strSQL = "SELECT stor_name FROM Stores " & _

"ORDER BY stor_name"

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

' Open recordset as a static cursor type recordset.

Set arstStores(1) = New ADODB.Recordset

arstStores(1).CursorType = adOpenStatic

arstStores(1).LockType = adLockBatchOptimistic

arstStores(1).Open strSQL, strCnn, , , adCmdText

' Create two clones of the original Recordset.

Set arstStores(2) = arstStores(1).Clone

Set arstStores(3) = arstStores(1).Clone

Do While True

' Loop through the array so that on each pass,

' the user is searching a different copy of the

' same Recordset.

For intLoop = 1 To 3

' Ask for search string while showing where

' the current record pointer is for each Recordset.

strMessage = _

"Recordsets from stores table:" & vbCr & _

" 1 - Original - Record pointer at " & _

arstStores(1)!stor_name & vbCr & _

" 2 - Clone - Record pointer at " & _

arstStores(2)!stor_name & vbCr & _

" 3 - Clone - Record pointer at " & _

arstStores(3)!stor_name & vbCr & _

"Enter search string for #" & intLoop & ":"

strFind = Trim(InputBox(strMessage))

If strFind = "" Then Exit Do

' Find the search string; if there's no

' match, jump to the last record.

arstStores(intLoop).Filter = "stor_name >= '" & strFind & "'"

If arstStores(intLoop).EOF Then

arstStores(intLoop).Filter = adFilterNone

arstStores(intLoop).MoveLast

End If

Next intLoop

Loop

arstStores(1).Close

arstStores(2).Close

arstStores(3).Close

End Sub

VBScript Version

The following is the same example written in VBScript to be used in an Active Server Page (ASP). To view this fully functional example, you need to create a system Data Source Name (DSN) called AdvWorks using the data source AdvWorks.mdb installed with IIS and located at C:\InetPub\ASPSamp\AdvWorks. This is a Microsoft Access database file. Use Find to locate the file adovbs.inc and place it in the directory you plan to use. Cut and paste the following code to Notepad or another text editor and save it as Clone.asp. You can view the result in any client browser.

To exercise the example, change the line RsCustomerList.Source = "Customers" to RsCustomerList.Source = "Products" to count a larger table.

<% Language = VBScript %>

<TITLE>ADO 1.5 Clone Method</TITLE>

</HEAD><BODY> <Center>

<H3>ADO Clone Method</H3>

'Create and open Connection object

Set OBJdbConnection = Server.CreateObject("ADODB.Connection")

OBJdbConnection.Open "AdvWorks"

'Create and open Recordset object

Set RsCustomerList = Server.CreateObject("ADODB.Recordset")

RsCustomerList.ActiveConnection = OBJdbConnection

RsCustomerList.CursorType = adOpenKeyset

RsCustomerList.LockType = adLockOptimistic

RsCustomerList.Source = "Customers"

RsCustomerList.Open

<HR>

Set MyRecordset = RSCustomerList.Clone

Counter = 0

Do Until MyRecordset.EOF

Counter = Counter + 1

MyRecordset.MoveNext

Loop

<H3>There Are <%=Counter %> Records in the Customers Table</H3>

<H4>Location of DSN Datbase</H4>

<%' Show location of DSN data source

Response.Write(OBJdbConnection)

#$>A TDelete Method Example

This example uses the Delete method to remove a specified record from a Recordset.

Public Sub DeleteX()

Dim rstRoySched As ADODB.Recordset

Dim strCnn As String

Dim strMsg As String

Dim strTitleID As String

Dim intLoRange As Integer

Dim intHiRange As Integer

Dim intRoyalty As Integer

' Open RoySched table.

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

Set rstRoySched = New ADODB.Recordset

rstRoySched.CursorLocation = adUseClient

rstRoySched.CursorType = adOpenKeyset

rstRoySched.LockType = adLockBatchOptimistic

rstRoySched.Open "SELECT * FROM roysched " & _

"WHERE royalty = 20", strCnn, , , adCmdText

' Prompt for a record to delete.

strMsg = "Before delete there are " & _

rstRoySched.RecordCount & _

" titles with 20 percent royalty:" & vbCr & vbCr

Do While Not rstRoySched.EOF

strMsg = strMsg & rstRoySched!title_id & vbCr

rstRoySched.MoveNext

Loop

strMsg = strMsg & vbCr & vbCr & _

"Enter the ID of a record to delete:"

strTitleID = UCase(InputBox(strMsg))

' Move to the record and save data so it can be restored.

rstRoySched.Filter = "title_id = '" & strTitleID & "'"

intLoRange = rstRoySched!lorange

intHiRange = rstRoySched!hirange

intRoyalty = rstRoySched!royalty

' Delete the record.

rstRoySched.Delete

rstRoySched.UpdateBatch

' Show the results.

rstRoySched.Filter = adFilterNone

rstRoySched.Requery

strMsg = ""

strMsg = "After delete there are " & _

rstRoySched.RecordCount & _

" titles with 20 percent royalty:" & vbCr & vbCr

Do While Not rstRoySched.EOF

strMsg = strMsg & rstRoySched!title_id & vbCr

rstRoySched.MoveNext

Loop

MsgBox strMsg

' Restore the data because this is a demonstration.

rstRoySched.AddNew

rstRoySched!title_id = strTitleID

rstRoySched!lorange = intLoRange

rstRoySched!hirange = intHiRange

rstRoySched!royalty = intRoyalty

rstRoySched.UpdateBatch

rstRoySched.Close

End Sub

VBScript Version

The following is the same example written in VBScript to be used in an Active Server Page (ASP). To view this fully functional example, you need to create a system Data Source Name (DSN) called AdvWorks using the data source AdvWorks.mdb installed with IIS and located at C:\InetPub\ASPSamp\AdvWorks. This is a Microsoft Access database file. Use Find to locate the file adovbs.inc and place it in the directory you plan to use. Cut and paste the following code to Notepad or another text editor and save it as Delete.asp. You can view the result in any client browser.

To exercise the example, try using the AddNew example first to add some records. Then you may try to delete them. View the result in any client browser.

<% Language = VBScript %>

<HTML>

<HEAD><TITLE>ADO 1.5 Delete Method</TITLE>

</HEAD><BODY>

<Center><H3>ADO Delete Method</H3>

'Create and Open Connection Object

Set OBJdbConnection = Server.CreateObject("ADODB.Connection")

OBJdbConnection.Open "AdvWorks"

'Create and Open Recordset Object

Set RsCustomerList = Server.CreateObject("ADODB.Recordset")

RsCustomerList.ActiveConnection = OBJdbConnection

RsCustomerList.CursorType = adOpenKeyset

RsCustomerList.LockType = adLockOptimistic

RsCustomerList.Source = "Customers"

RsCustomerList.Open

If Not IsEmpty(Request.Form("WhichRecord")) Then

'Get value to move from Form Post method

Moves = Request.Form("WhichRecord")

RsCustomerList.Move CInt(Moves)

If Not RsCustomerList.EOF or RsCustomerList.BOF Then

RsCustomerList.Delete 1

RsCustomerList.MoveFirst

Else

Response.Write "Not a Valid Record Number"

RsCustomerList.MoveFirst

End If

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Company Name</FONT>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Contact Name</FONT>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Phone Number</FONT>

</TD>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>State/Province</FONT>

</TD></TR>

<!--Display ADO Data from Customer Table Loop through Recordset adding

One Row to HTML Table each pass-->

<% Do While Not RsCustomerList.EOF %>

<%= RSCustomerList("CompanyName")%>

</FONT></TD>

<%= RScustomerList("ContactLastName") & ", " %>

<%= RScustomerList("ContactFirstName") %>

</FONT></TD>

<%= RScustomerList("PhoneNumber")%>

</FONT></TD>

<%= RScustomerList("City")%>

</FONT></TD>

<%= RScustomerList("StateOrProvince")%>

</FONT></TD>

</TR>

<!-Next Row = Record Loop and add to html table-->

RScustomerList.MoveNext

Loop

</Table></Center></FONT>

<H4>Clicking Button Will Remove Designated Record</H4>

<H5>There are <%=RsCustomerList.RecordCount - 1%> Records in this Set</H5>

</BODY>

Sub cmdDelete_OnClick

If IsNumeric(Document.Form.WhichRecord.Value) Then

Document.Form.WhichRecord.Value = CInt(Document.Form.WhichRecord.Value)

Dim Response

Response = MsgBox("Are You Sure About Deleting This Record?", vbYesNo, "ADO-ASP

Example")

If Response = vbYes Then

Document.Form.Submit

End If

Else

MsgBox "You Must Enter a Valid Record Number",,"ADO-ASP Example"

End If

End Sub

</Script>

</HTML>

#$>A TExecute, Requery, and Clear Methods Example

This example demonstrates the Execute method when run from both a Command object and a Connection object. It also uses the Requery method to retrieve current data in a recordset, and the Clear method to clear the contents of the Errors collection. The ExecuteCommand and PrintOutput procedures are required for this procedure to run.

Public Sub ExecuteX()

Dim strSQLChange As String

Dim strSQLRestore As String

Dim strCnn As String

Dim cnn1 As ADODB.Connection

Dim cmdChange As ADODB.Command

Dim rstTitles As ADODB.Recordset

Dim errLoop As ADODB.Error

' Define two SQL statements to execute as command text.

strSQLChange = "UPDATE Titles SET Type = " & _

"'self_help' WHERE Type = 'psychology'"

strSQLRestore = "UPDATE Titles SET Type = " & _

"'psychology' WHERE Type = 'self_help'"

' Open connection.

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

Set cnn1 = New ADODB.Connection

cnn1.Open strCnn

' Create command object.

Set cmdChange = New ADODB.Command

Set cmdChange.ActiveConnection = cnn1

cmdChange.CommandText = strSQLChange

' Open titles table.

Set rstTitles = New ADODB.Recordset

rstTitles.Open "titles", cnn1, , , adCmdTable

' Print report of original data.

Debug.Print _

"Data in Titles table before executing the query"

PrintOutput rstTitles

' Clear extraneous errors from the Errors collection.

cnn1.Errors.Clear

' Call the ExecuteCommand subroutine to execute cmdChange command.

ExecuteCommand cmdChange, rstTitles

' Print report of new data.

Debug.Print _

"Data in Titles table after executing the query"

PrintOutput rstTitles

' Use the Connection object's execute method to

' execute SQL statement to restore data. Trap for

' errors, checking the Errors collection if necessary.

On Error GoTo Err_Execute

cnn1.Execute strSQLRestore

On Error GoTo 0

' Retrieve the current data by requerying the recordset.

rstTitles.Requery

' Print report of restored data.

Debug.Print "Data after executing the query " & _

"to restore the original information"

PrintOutput rstTitles

rstTitles.Close

cnn1.Close

Exit Sub

Err_Execute:

' Notify user of any errors that result from

' executing the query.

If Errors.Count > 0 Then

For Each errLoop In Errors

MsgBox "Error number: " & errLoop.Number & vbCr & _

errLoop.Description

Next errLoop

End If

Resume Next

End Sub

Public Sub ExecuteCommand(cmdTemp As ADODB.Command, _

rstTemp As ADODB.Recordset)

Dim errLoop As Error

' Run the specified Command object. Trap for

' errors, checking the Errors collection if necessary.

On Error GoTo Err_Execute

cmdTemp.Execute

On Error GoTo 0

' Retrieve the current data by requerying the recordset.

rstTemp.Requery

Exit Sub

Err_Execute:

' Notify user of any errors that result from

' executing the query.

If Errors.Count > 0 Then

For Each errLoop In Errors

MsgBox "Error number: " & errLoop.Number & vbCr & _

errLoop.Description

Next errLoop

End If

Resume Next

End Sub

Public Sub PrintOutput(rstTemp As ADODB.Recordset)

' Enumerate Recordset.

Do While Not rstTemp.EOF

Debug.Print " " & rstTemp!Title & _

", " & rstTemp!Type

rstTemp.MoveNext

Loop

End Sub

VBScript Version

The following is the same example written in VBScript to be used in an Active Server Page (ASP). To view this fully functional example, you need to create a system Data Source Name (DSN) called AdvWorks using the data source AdvWorks.mdb installed with IIS and located at C:\InetPub\ASPSamp\AdvWorks. This is a Microsoft Access database file. Use Find to locate the file adovbs.inc and place it in the directory you plan to use. Cut and paste the following code to Notepad or another text editor and save it as Execute.asp. You can view the result in any client browser.

<TITLE>ADO 1.5 Execute Method</TITLE></HEAD>

<BODY>

<Center><H3>ADO Execute Method</H3><H4>Recordset Retrieved Using Connection Object</H4>

Set OBJdbConnection = Server.CreateObject("ADODB.Connection")

OBJdbConnection.Open "AdvWorks"

SQLQuery = "SELECT * FROM Customers"

'First Recordset RSCustomerList

Set RSCustomerList = OBJdbConnection.Execute(SQLQuery)

Set OBJdbCommand = Server.CreateObject("ADODB.Command")

OBJdbCommand.ActiveConnection = OBJdbConnection

SQLQuery2 = "SELECT * From Products"

OBJdbCommand.CommandText = SQLQuery2

Set RsProductList = OBJdbCommand.Execute

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Company Name</FONT>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Contact Name</FONT>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>E-mail address</FONT>

</TD>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>State/Province</FONT>

</TD></TR>

<% Do While Not RScustomerList.EOF %>

<TR>

<%= RSCustomerList("CompanyName")%>

</FONT></TD>

<%= RScustomerList("ContactLastName") & ", " %>

<%= RScustomerList("ContactFirstName") %>

</FONT></TD>

<%= RScustomerList("ContactLastName")%>

</FONT></TD>

<%= RScustomerList("City")%>

</FONT></TD>

<%= RScustomerList("StateOrProvince")%>

</FONT></TD>

</TR>

<!-Next Row = Record Loop and add to html table-->

RScustomerList.MoveNext

Loop

RScustomerList.Close

</TABLE><HR>

<H4>Recordset Retrieved Using Command Object</H4>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Product Type</FONT>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Product Name</FONT>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Product Description</FONT>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Unit Price</FONT>

</TD></TR>

<% Do While Not RsProductList.EOF %>

<TR>

<%= RsProductList("ProductType")%>

</FONT></TD>

<%= RsProductList("ProductName")%>

</FONT></TD>

<%= RsProductList("ProductDescription")%>

</FONT></TD>

<%= RsProductList("UnitPrice")%>

</FONT></TD>

RsProductList.MoveNext

Loop

'Remove objects from memory to free resources

RsProductList.Close

OBJdbConnection.Close

Set ObJdbCommand = Nothing

Set RsProductList = Nothing

Set OBJdbConnection = Nothing

</TABLE></FONT></Center></BODY></HTML>

#$>A TGetRows Method Example

This example uses the GetRows method to retrieve a specified number of rows from a Recordset and to fill an array with the resulting data. The GetRows method will return fewer than the desired number of rows in two cases: either if EOF has been reached, or if GetRows tried to retrieve a record that was deleted by another user. The function returns False only if the second case occurs. The GetRowsOK function is required for this procedure to run.

Public Sub GetRowsX()

Dim rstEmployees As ADODB.Recordset

Dim strCnn As String

Dim strMessage As String

Dim intRows As Integer

Dim avarRecords As Variant

Dim intRecord As Integer

' Open recordset with names and hire dates from employee table.

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

Set rstEmployees = New ADODB.Recordset

rstEmployees.Open "SELECT fName, lName, hire_date " & _

"FROM Employee ORDER BY lName", strCnn, , , adCmdText

Do While True

' Get user input for number of rows.

strMessage = "Enter number of rows to retrieve."

intRows = Val(InputBox(strMessage))

If intRows <= 0 Then Exit Do

' If GetRowsOK is successful, print the results,

' noting if the end of the file was reached.

If GetRowsOK(rstEmployees, intRows, _

avarRecords) Then

If intRows > UBound(avarRecords, 2) + 1 Then

Debug.Print "(Not enough records in " & _

"Recordset to retrieve " & intRows & _

" rows.)"

End If

Debug.Print UBound(avarRecords, 2) + 1 & _

" records found."

' Print the retrieved data.

For intRecord = 0 To UBound(avarRecords, 2)

Debug.Print " " & _

avarRecords(0, intRecord) & " " & _

avarRecords(1, intRecord) & ", " & _

avarRecords(2, intRecord)

Next intRecord

Else

' Assuming the GetRows error was due to data

' changes by another user, use Requery to

' refresh the Recordset and start over.

If MsgBox("GetRows failed--retry?", _

vbYesNo) = vbYes Then

rstEmployees.Requery

Else

Debug.Print "GetRows failed!"

Exit Do

End If

' Because using GetRows leaves the current

' record pointer at the last record accessed,

' move the pointer back to the beginning of the

' Recordset before looping back for another search.

rstEmployees.MoveFirst

Loop

rstEmployees.Close

End Sub

Public Function GetRowsOK(rstTemp As ADODB.Recordset, _

intNumber As Integer, avarData As Variant) As Boolean

' Store results of GetRows method in array.

avarData = rstTemp.GetRows(intNumber)

' Return False only if fewer than the desired

' number of rows were returned, but not because the

' end of the Recordset was reached.

If intNumber > UBound(avarData, 2) + 1 And _

Not rstTemp.EOF Then

GetRowsOK = False

Else

GetRowsOK = True

End If

End Function

#$>A TMove Method Example

This example uses the Move method to position the record pointer based on user input.

Public Sub MoveX()

Dim rstAuthors As ADODB.Recordset

Dim strCnn As String

Dim varBookmark As Variant

Dim strCommand As String

Dim lngMove As Long

' Open recordset from Authors table.

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

Set rstAuthors = New ADODB.Recordset

rstAuthors.CursorType = adOpenStatic

' Use client cursor to allow use of

' AbsolutePosition property.

rstAuthors.CursorLocation = adUseClient

rstAuthors.Open "SELECT au_id, au_fname, au_lname, city, state " & _

"FROM Authors ORDER BY au_lname", strCnn, , , adCmdText

rstAuthors.MoveFirst

Do While True

' Display information about current record and

' ask how many records to move.

strCommand = InputBox( _

"Record " & rstAuthors.AbsolutePosition & _

" of " & rstAuthors.RecordCount & vbCr & _

"Author: " & rstAuthors!au_fname & _

" " & rstAuthors!au_lname & vbCr & _

"Location: " & rstAuthors!City & _

", " & rstAuthors!State & vbCr & vbCr & _

"Enter number of records to Move " & _

"(positive or negative).")

If strCommand = "" Then Exit Do

' Store bookmark in case the Move goes too far

' forward or backward.

varBookmark = rstAuthors.Bookmark

' Move method requires parameter of data type Long.

lngMove = CLng(strCommand)

rstAuthors.Move lngMove

' Trap for BOF or EOF.

If rstAuthors.BOF Then

MsgBox "Too far backward! " & _

"Returning to current record."

rstAuthors.Bookmark = varBookmark

End If

If rstAuthors.EOF Then

MsgBox "Too far forward! " & _

"Returning to current record."

rstAuthors.Bookmark = varBookmark

End If

Loop

rstAuthors.Close

End Sub

VBScript Version

The following is the same example written in VBScript to be used in an Active Server Page (ASP). To view this fully functional example, you need to create a system Data Source Name (DSN) called AdvWorks using the data source AdvWorks.mdb installed with IIS and located at C:\InetPub\ASPSamp\AdvWorks. This is a Microsoft Access database file. Use Find to locate the file adovbs.inc and place it in the directory you plan to use. Cut and paste the following code to Notepad or another text editor and save it as Move.asp. You can view the result in any client browser.

Try entering a letter or non integer to see the error handling work.

<% Language = VBScript %>

<TITLE>ADO 1.5 Move Methods</TITLE></HEAD>

<BODY>

<H3>ADO Move Methods</H3>

'Create and Open Connection Object

Set OBJdbConnection = Server.CreateObject("ADODB.Connection")

OBJdbConnection.Open "AdvWorks"

'Create and Open Recordset Object

Set RsCustomerList = Server.CreateObject("ADODB.Recordset")

RsCustomerList.ActiveConnection = OBJdbConnection

RsCustomerList.CursorType = adOpenKeyset

RsCustomerList.LockType = adLockOptimistic

RsCustomerList.Source = "Customers"

RsCustomerList.Open

'Check number of user moves this session

'Increment by amount in Form

Session("Clicks") = Session("Clicks") + Request.Form("MoveAmount")

Clicks = Session("Clicks")

'Move to last known recordset position plus amount passed

'by Form Post method

RsCustomerList.Move CInt(Clicks)

'Error Handling

If RsCustomerList.EOF Then

Session("Clicks") = RsCustomerList.RecordCount

Response.Write "This is the Last Record"

RsCustomerList.MoveLast

Else If RsCustomerList.BOF Then

Session("Clicks") = 1

RsCustomerList.MoveFirst

Response.Write "This is the First Record"

End If

<H3>Current Record Number is <BR>

<% If Session("Clicks") = 0 Then

Session("Clicks") = 1

End If

Response.Write(Session("Clicks") )%> of <%=RsCustomerList.RecordCount%></H3>

<HR>

<TR>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Company Name</FONT>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Contact Name</FONT>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Phone Number</FONT>

</TD>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>State/Province</FONT>

</TD>

</TR>

<TR>

<%= RSCustomerList("CompanyName")%>

</FONT></TD>

<%= RScustomerList("ContactLastName") & ", " %>

<%= RScustomerList("ContactFirstName") %>

</FONT></TD>

<%= RScustomerList("PhoneNumber")%>

</FONT></TD>

<%= RScustomerList("City")%>

</FONT></TD>

<%= RScustomerList("StateOrProvince")%>

</FONT></TD>

</TR> </Table></FONT>

<HR>

<H5>Click Direction Arrows for Previous or Next Record

<BR> Click Move Amount to use Move Method

Enter Number of Records to Move + or - </H5>

<Table>

</Form></Table></Center>

</BODY>

Sub Move_OnClick

' Make sure move value entered is an integer

If IsNumeric(Document.Form.MoveAmount.Value)Then

Document.Form.MoveAmount.Value = CInt(Document.Form.MoveAmount.Value)

Document.Form.Submit

Else

MsgBox "You Must Enter a Number", ,"ADO-ASP Example"

Document.Form.MoveAmount.Value = 0

End If

End Sub

Sub cmdDown_OnClick

Document.Form.MoveAmount.Value = -1

Document.Form.Submit

End Sub

Sub cmdUp_OnClick

Document.Form.MoveAmount.Value = 1

Document.Form.Submit

End Sub

</Script>

</HTML>

#$>A TMoveFirst, MoveLast, MoveNext, and MovePrevious Methods Example

This example uses the MoveFirst, MoveLast, MoveNext, and MovePrevious methods to move the record pointer of a Recordset based on the supplied command. The MoveAny procedure is required for this procedure to run.

Public Sub MoveFirstX()

Dim rstAuthors As ADODB.Recordset

Dim strCnn As String

Dim strMessage As String

Dim intCommand As Integer

' Open recordset from Authors table.

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

Set rstAuthors = New ADODB.Recordset

rstAuthors.CursorType = adOpenStatic

' Use client cursor to enable AbsolutePosition property.

rstAuthors.CursorLocation = adUseClient

rstAuthors.Open "authors", strCnn, , , adCmdTable

' Show current record information and get user's method choice.

Do While True

strMessage = "Name: " & rstAuthors!au_fName & " " & _

rstAuthors!au_lName & vbCr & "Record " & _

rstAuthors.AbsolutePosition & " of " & _

rstAuthors.RecordCount & vbCr & vbCr & _

"[1 - MoveFirst, 2 - MoveLast, " & vbCr & _

"3 - MoveNext, 4 - MovePrevious]"

intCommand = Val(Left(InputBox(strMessage), 1))

If intCommand < 1 Or intCommand > 4 Then Exit Do

' Call method based on user's input.

MoveAny intCommand, rstAuthors

Loop

rstAuthors.Close

End Sub

Public Sub MoveAny(intChoice As Integer, _

rstTemp As Recordset)

' Use specified method, trapping for BOF and EOF.

Select Case intChoice

Case 1

rstTemp.MoveFirst

Case 2

rstTemp.MoveLast

Case 3

rstTemp.MoveNext

If rstTemp.EOF Then

MsgBox "Already at end of recordset!"

rstTemp.MoveLast

End If

Case 4

rstTemp.MovePrevious

If rstTemp.BOF Then

MsgBox "Already at beginning of recordset!"

rstTemp.MoveFirst

End If

End Select

End Sub

VBScript Version

The following is the same example written in VBScript to be used in an Active Server Page (ASP). To view this fully functional example, you need to create a system Data Source Name (DSN) called AdvWorks using the data source AdvWorks.mdb installed with IIS and located at C:\InetPub\ASPSamp\AdvWorks. This is a Microsoft Access database file. Use Find to locate the file adovbs.inc and place it in the directory you plan to use. Cut and paste the following code to Notepad or another text editor and save it as MoveOne.asp. You can view the result in any client browser.

Try moving beyond the upper or lower limits of the recordset to see error handling work.

<% Language = VBScript %>

<TITLE>ADO 1.5 MoveNext MovePrevious MoveLast MoveFirst Methods</TITLE></HEAD>

<BODY>

<H3>ADO Methods<BR>MoveNext MovePrevious MoveLast MoveFirst</H3>

'Create and Open Connection Object

Set OBJdbConnection = Server.CreateObject("ADODB.Connection")

OBJdbConnection.Open "AdvWorks"

'Create and Open Recordset Object

Set RsCustomerList = Server.CreateObject("ADODB.Recordset")

RsCustomerList.ActiveConnection = OBJdbConnection

RsCustomerList.CursorType = adOpenKeyset

RsCustomerList.LockType = adLockOptimistic

RsCustomerList.Source = "Customers"

RsCustomerList.Open

' Check Request.Form collection to see if any moves are recorded

If Not IsEmpty(Request.Form("MoveAmount")) Then

'Keep track of the number and direction of moves this session

Session("Moves") = Session("Moves") + Request.Form("MoveAmount")

Clicks = Session("Moves")

'Move to last known position

RsCustomerList.Move CInt(Clicks)

'Check if move is + or - and do error checking

If CInt(Request.Form("MoveAmount")) = 1 Then

If RsCustomerList.EOF Then

Session("Moves") = RsCustomerList.RecordCount

RsCustomerList.MoveLast

End If

RsCustomerList.MoveNext

End If

If Request.Form("MoveAmount") < 1 Then

RsCustomerList.MovePrevious

End If

'Check if First Record or Last Record Command Buttons Clicked

If Request.Form("MoveLast") = 3 Then

RsCustomerList.MoveLast

Session("Moves") = RsCustomerList.RecordCount

End If

If Request.Form("MoveFirst") = 2 Then

RsCustomerList.MoveFirst

Session("Moves") = 1

End If

' Do Error checking for combination of Move Button clicks

If RsCustomerList.EOF Then

Session("Moves") = RsCustomerList.RecordCount

RsCustomerList.MoveLast

Response.Write "This is the Last Record"

End If

If RsCustomerList.BOF Then

Session("Moves") = 1

RsCustomerList.MoveFirst

Response.Write "This is the First Record"

End If

<H3>Current Record Number is <BR>

<% If IsEmpty(Session("Moves")) Then

Session("Moves") = 1

End If

<%Response.Write(Session("Moves") )%> of <%=RsCustomerList.RecordCount%></H3>

<HR>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Company Name</FONT>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Contact Name</FONT>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Phone Number</FONT>

</TD>

</TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>State/Province</FONT>

</TD></TR>

<TR>

<%= RSCustomerList("CompanyName")%>

</FONT></TD>

<%= RScustomerList("ContactLastName") & ", " %>

<%= RScustomerList("ContactFirstName") %>

</FONT></TD>

<%= RScustomerList("PhoneNumber")%>

</FONT></TD>

<%= RScustomerList("City")%>

</FONT></TD>

<%= RScustomerList("StateOrProvince")%>

</FONT></TD>

</TR> </Table></FONT>

<HR>

<BR>

<H5>Click Direction Arrows to Use MovePrevious or MoveNext

</Form></BODY>

Sub cmdDown_OnClick

'Set Values in Form Input Boxes and Submit Form

Document.Form.MoveAmount.Value = -1

Document.Form.Submit

End Sub

Sub cmdUp_OnClick

Document.Form.MoveAmount.Value = 1

Document.Form.Submit

End Sub

Sub cmdFirst_OnClick

Document.Form.MoveFirst.Value = 2

Document.Form.Submit

End Sub

Sub cmdLast_OnClick

Document.Form.MoveLast.Value = 3

Document.Form.Submit

End Sub

</Script></HTML>

#$>A TNextRecordset Method Example

This example uses the NextRecordset method to view the data in a recordset that uses a compound command statement made up of three separate SELECT statements.

Public Sub NextRecordsetX()

Dim rstCompound As ADODB.Recordset

Dim strCnn As String

Dim intCount As Integer

' Open compound recordset.

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

Set rstCompound = New ADODB.Recordset

rstCompound.Open "SELECT * FROM authors; " & _

"SELECT * FROM stores; " & _

"SELECT * FROM jobs", strCnn, , , adCmdText

' Display results from each SELECT statement.

intCount = 1

Do Until rstCompound Is Nothing

Debug.Print "Contents of recordset #" & intCount

Do While Not rstCompound.EOF

Debug.Print , rstCompound.Fields(0), _

rstCompound.Fields(1)

rstCompound.MoveNext

Loop

Set rstCompound = rstCompound.NextRecordset

intCount = intCount + 1

Loop

End Sub

#$>A TOpen and Close Methods Example

This example uses the Open and Close methods on both Recordset and Connection objects that have been opened.

Public Sub OpenX()

Dim cnn1 As ADODB.Connection

Dim rstEmployees As ADODB.Recordset

Dim strCnn As String

Dim varDate As Variant

' Open connection.

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

Set cnn1 = New ADODB.Connection

cnn1.Open strCnn

' Open employee table.

Set rstEmployees = New ADODB.Recordset

rstEmployees.CursorType = adOpenKeyset

rstEmployees.LockType = adLockOptimistic

rstEmployees.Open "employee", cnn1, , , adCmdTable

' Assign the first employee record's hire date

' to a variable, then change the hire date.

varDate = rstEmployees!hire_date

Debug.Print "Original data"

Debug.Print " Name - Hire Date"

Debug.Print " " & rstEmployees!fName & " " & _

rstEmployees!lName & " - " & rstEmployees!hire_date

rstEmployees!hire_date = #1/1/1900#

rstEmployees.Update

Debug.Print "Changed data"

Debug.Print " Name - Hire Date"

Debug.Print " " & rstEmployees!fName & " " & _

rstEmployees!lName & " - " & rstEmployees!hire_date

' Requery Recordset and reset the hire date.

rstEmployees.Requery

rstEmployees!hire_date = varDate

rstEmployees.Update

Debug.Print "Data after reset"

Debug.Print " Name - Hire Date"

Debug.Print " " & rstEmployees!fName & " " & _

rstEmployees!lName & " - " & rstEmployees!hire_date

rstEmployees.Close

cnn1.Close

End Sub

VBScript Version

The following is the same example written in VBScript to be used in an Active Server Page (ASP). To view this fully functional example, you need to create a system Data Source Name (DSN) called AdvWorks using the data source AdvWorks.mdb installed with IIS and located at C:\InetPub\ASPSamp\AdvWorks. This is a Microsoft Access database file. Use Find to locate the file adovbs.inc and place it in the directory you plan to use. Cut and paste the following code to Notepad or another text editor and save it as ADOOpen.asp. You can view the result in any client browser.

<TITLE>ADO 1.5 Open Method</TITLE>

</HEAD><BODY>

<Center><H3>ADO Open Method</H3>

Set OBJdbConnection = Server.CreateObject("ADODB.Connection")

OBJdbConnection.Open "AdvWorks"

SQLQuery = "SELECT * FROM Customers"

'First Recordset RSCustomerList

Set RSCustomerList = OBJdbConnection.Execute(SQLQuery)

'Second Recordset RsProductist

Set RsProductList = Server.CreateObject("ADODB.Recordset")

RsProductList.CursorType = adOpenDynamic

RsProductList.LockType = adLockOptimistic

RsProductList.Open "Products", OBJdbConnection

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Company Name</FONT></TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Contact Name</FONT></TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>E-mail address</FONT></TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>State/Province</FONT></TD></TR>

<% Do While Not RScustomerList.EOF %>

<%= RSCustomerList("CompanyName")%>

</FONT></TD>

<%= RScustomerList("ContactLastName") & ", " %>

<%= RScustomerList("ContactFirstName") %>

</FONT></TD>

<%= RScustomerList("ContactLastName")%>

</FONT></TD>

<%= RScustomerList("City")%>

</FONT></TD>

<%= RScustomerList("StateOrProvince")%>

</FONT></TD></TR>

<!-Next Row = Record Loop and add to html table-->

RScustomerList.MoveNext

Loop

RScustomerList.Close

OBJdbConnection.Close

</TABLE>

<HR>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Product Type</FONT></TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Product Name</FONT></TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Product Description</FONT></TD>

<FONT STYLE="ARIAL NARROW" COLOR="#ffffff" SIZE=1>Unit Price</FONT></TD></TR>

<% Do While Not RsProductList.EOF %>

<%= RsProductList("ProductType")%>

</FONT></TD>

<%= RsProductList("ProductName")%>

</FONT></TD>

<%= RsProductList("ProductDescription")%>

</FONT></TD>

<%= RsProductList("UnitPrice")%>

</FONT></TD>

RsProductList.MoveNext

Loop

'Remove Objects from Memory Freeing

Set RsProductList = Nothing

Set OBJdbConnection = Nothing

</TABLE></FONT></Center></BODY></HTML>

#$>A TOpenSchema Method Example

This example uses the OpenSchema method to display the name and type of each table in the Pubs database.

Public Sub OpenSchemaX()

Dim cnn1 As ADODB.Connection

Dim rstSchema As ADODB.Recordset

Dim strCnn As String

Set cnn1 = New ADODB.Connection

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

cnn1.Open strCnn

Set rstSchema = cnn1.OpenSchema(adSchemaTables)

Do Until rstSchema.EOF

Debug.Print "Table name: " & _

rstSchema!TABLE_NAME & vbCr & _

"Table type: " & rstSchema!TABLE_TYPE & vbCr

rstSchema.MoveNext

Loop

rstSchema.Close

cnn1.Close

End Sub

#$>A TRefresh Method Example

This example demonstrates using the Refresh method to refresh the Parameters collection for a stored procedure Command object.

Public Sub RefreshX()

Dim cnn1 As ADODB.Connection

Dim cmdByRoyalty As ADODB.Command

Dim rstByRoyalty As ADODB.Recordset

Dim rstAuthors As ADODB.Recordset

Dim intRoyalty As Integer

Dim strAuthorID As String

Dim strCnn As String

' Open connection.

Set cnn1 = New ADODB.Connection

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

cnn1.Open strCnn

' Open a command object for a stored procedure

' with one parameter.

Set cmdByRoyalty = New ADODB.Command

Set cmdByRoyalty.ActiveConnection = cnn1

cmdByRoyalty.CommandText = "byroyalty"

cmdByRoyalty.CommandType = adCmdStoredProc

cmdByRoyalty.Parameters.Refresh

' Get paramater value and execute the command,

' storing the results in a recordset.

intRoyalty = Trim(InputBox("Enter royalty:"))

cmdByRoyalty.Parameters(1) = intRoyalty

Set rstByRoyalty = cmdByRoyalty.Execute()

' Open the Authors table to get author names for display.

Set rstAuthors = New ADODB.Recordset

rstAuthors.Open "authors", cnn1, , , adCmdTable

' Print current data in the recordset, adding

' author names from Authors table.

Debug.Print "Authors with " & intRoyalty & " percent royalty"

Do While Not rstByRoyalty.EOF

strAuthorID = rstByRoyalty!au_id

Debug.Print " " & rstByRoyalty!au_id & ", ";

rstAuthors.Filter = "au_id = '" & strAuthorID & "'"

Debug.Print rstAuthors!au_fname & " " & _

rstAuthors!au_lname

rstByRoyalty.MoveNext

Loop

rstByRoyalty.Close

rstAuthors.Close

cnn1.Close

End Sub

#$>A TResync Method Example

This example demonstrates using the Resync method to refresh data in a static recordset.

Public Sub ResyncX()

Dim strCnn As String

Dim rstTitles As ADODB.Recordset

' Open connections.

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

' Open recordset for titles table.

Set rstTitles = New ADODB.Recordset

rstTitles.CursorType = adOpenStatic

rstTitles.LockType = adLockBatchOptimistic

rstTitles.Open "titles", strCnn, , , adCmdTable

' Change the type of the first title in the recordset.

rstTitles!Type = "database"

' Display the results of the change.

MsgBox "Before resync: " & vbCr & vbCr & _

"Title - " & rstTitles!Title & vbCr & _

"Type - " & rstTitles!Type

' Resync with database and redisplay results.

rstTitles.Resync

MsgBox "After resync: " & vbCr & vbCr & _

"Title - " & rstTitles!Title & vbCr & _

"Type - " & rstTitles!Type

rstTitles.CancelBatch

rstTitles.Close

End Sub

#$>A TSupports Method Example

This example uses the Supports method to display the options supported by a recordset opened with different cursor types. The DisplaySupport procedure is required for this procedure to run.

Public Sub SupportsX()

Dim aintCursorType(4) As Integer

Dim rstTitles As ADODB.Recordset

Dim strCnn As String

Dim intIndex As Integer

' Open connections.

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

' Fill array with CursorType constants.

aintCursorType(0) = adOpenForwardOnly

aintCursorType(1) = adOpenKeyset

aintCursorType(2) = adOpenDynamic

aintCursorType(3) = adOpenStatic

' Open recordset using each CursorType and

' optimitic locking. Then call the DisplaySupport

' procedure to display the supported options.

For intIndex = 0 To 3

Set rstTitles = New ADODB.Recordset

rstTitles.CursorType = aintCursorType(intIndex)

rstTitles.LockType = adLockOptimistic

rstTitles.Open "titles", strCnn, , , adCmdTable

Select Case aintCursorType(intIndex)

Case adOpenForwardOnly

Debug.Print "ForwardOnly cursor supports:"

Case adOpenKeyset

Debug.Print "Keyset cursor supports:"

Case adOpenDynamic

Debug.Print "Dynamic cursor supports:"

Case adOpenStatic

Debug.Print "Static cursor supports:"

End Select

DisplaySupport rstTitles

rstTitles.Close

Next intIndex

End Sub

Public Sub DisplaySupport(rstTemp As ADODB.Recordset)

Dim alngConstants(9) As Long

Dim booSupports As Boolean

Dim intIndex As Integer

' Fill array with cursor option constants.

alngConstants(0) = adAddNew

alngConstants(1) = adApproxPosition

alngConstants(2) = adBookmark

alngConstants(3) = adDelete

alngConstants(4) = adHoldRecords

alngConstants(5) = adMovePrevious

alngConstants(6) = adResync

alngConstants(7) = adUpdate

alngConstants(8) = adUpdateBatch

For intIndex = 0 To 8

booSupports = _

rstTemp.Supports(alngConstants(intIndex))

If booSupports Then

Select Case alngConstants(intIndex)

Case adAddNew

Debug.Print " AddNew"

Case adApproxPosition

Debug.Print " AbsolutePosition and AbsolutePage"

Case adBookmark

Debug.Print " Bookmark"

Case adDelete

Debug.Print " Delete"

Case adHoldRecords

Debug.Print " holding records"

Case adMovePrevious

Debug.Print " MovePrevious and Move"

Case adResync

Debug.Print " resyncing data"

Case adUpdate

Debug.Print " Update"

Case adUpdateBatch

Debug.Print " batch updating"

End Select

End If

Next intIndex

End Sub

#$>A TUpdate and CancelUpdate Methods Example

This example demonstrates the Update method in conjunction with CancelUpdate method.

Public Sub UpdateX()

Dim rstEmployees As ADODB.Recordset

Dim strOldFirst As String

Dim strOldLast As String

Dim strMessage As String

' Open recordset with names from Employee table.

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

Set rstEmployees = New ADODB.Recordset

rstEmployees.CursorType = adOpenKeyset

rstEmployees.LockType = adLockOptimistic

rstEmployees.Open "SELECT fname, lname " & _

"FROM Employee ORDER BY lname", strCnn, , , adCmdText

' Store original data.

strOldFirst = rstEmployees!fname

strOldLast = rstEmployees!lname

' Change data in edit buffer.

rstEmployees!fname = "Linda"

rstEmployees!lname = "Kobara"

' Show contents of buffer and get user input.

strMessage = "Edit in progress:" & vbCr & _

" Original data = " & strOldFirst & " " & _

strOldLast & vbCr & " Data in buffer = " & _

rstEmployees!fname & " " & rstEmployees!lname & vbCr & vbCr & _

"Use Update to replace the original data with " & _

"the buffered data in the Recordset?"

If MsgBox(strMessage, vbYesNo) = vbYes Then

rstEmployees.Update

Else

rstEmployees.CancelUpdate

End If

' Show the resulting data.

MsgBox "Data in recordset = " & rstEmployees!fname & " " & _

rstEmployees!lname

' Restore original data because this is a demonstration.

If Not (strOldFirst = rstEmployees!fname And _

strOldLast = rstEmployees!lname) Then

rstEmployees!fname = strOldFirst

rstEmployees!lname = strOldLast

rstEmployees.Update

End If

rstEmployees.Close

End Sub

This example demonstrates the Update method in conjunction with the AddNew method.

Public Sub UpdateX2()

Dim cnn1 As ADODB.Connection

Dim rstEmployees As ADODB.Recordset

Dim strEmpID As String

Dim strOldFirst As String

Dim strOldLast As String

Dim strMessage As String

' Open a connection.

Set cnn1 = New ADODB.Connection

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

cnn1.Open strCnn

' Open recordset with data from Employee table.

Set rstEmployees = New ADODB.Recordset

rstEmployees.CursorType = adOpenKeyset

rstEmployees.LockType = adLockOptimistic

rstEmployees.Open "employee", cnn1, , , adCmdTable

rstEmployees.AddNew

strEmpID = "B-S55555M"

rstEmployees!emp_id = strEmpID

rstEmployees!fname = "Bill"

rstEmployees!lname = "Sornsin"

' Show contents of buffer and get user input.

strMessage = "AddNew in progress:" & vbCr & _

"Data in buffer = " & rstEmployees!emp_id & ", " & _

rstEmployees!fname & " " & rstEmployees!lname & vbCr & vbCr & _

"Use Update to save buffer to recordset?"

If MsgBox(strMessage, vbYesNoCancel) = vbYes Then

rstEmployees.Update

' Go to the new record and show the resulting data.

MsgBox "Data in recordset = " & rstEmployees!emp_id & ", " & _

rstEmployees!fname & " " & rstEmployees!lname

Else

rstEmployees.CancelUpdate

MsgBox "No new record added."

End If

' Delete new data because this is a demonstration.

cnn1.Execute "DELETE FROM employee WHERE emp_id = '" & strEmpID & "'"

rstEmployees.Close

End Sub

#$>A TUpdateBatch and CancelBatch Methods Example

This example demonstrates the UpdateBatch method in conjunction with CancelBatch method.

Public Sub UpdateBatchX()

Dim rstTitles As ADODB.Recordset

Dim strCnn As String

Dim strTitle As String

Dim strMessage As String

' Assign connection string to variable.

strCnn = "driver={SQL Server};server=srv;" & _

"uid=sa;pwd=;database=pubs"

Set rstTitles = New ADODB.Recordset

rstTitles.CursorType = adOpenKeyset

rstTitles.LockType = adLockBatchOptimistic

rstTitles.Open "titles", strCnn, , , adCmdTable

rstTitles.MoveFirst

' Loop through recordset and ask user if she wants

' to change the type for a specified title.

Do Until rstTitles.EOF

If Trim(rstTitles!Type) = "psychology" Then

strTitle = rstTitles!Title

strMessage = "Title: " & strTitle & vbCr & _

"Change type to self help?"

If MsgBox(strMessage, vbYesNo) = vbYes Then

rstTitles!Type = "self_help"

End If

rstTitles.MoveNext

Loop

' Ask if the user wants to commit to all the

' changes made above.

If MsgBox("Save all changes?", vbYesNo) = vbYes Then

rstTitles.UpdateBatch

Else

rstTitles.CancelBatch

End If

' Print current data in recordset.

rstTitles.Requery

rstTitles.MoveFirst

Do While Not rstTitles.EOF

Debug.Print rstTitles!Title & " - " & rstTitles!Type

rstTitles.MoveNext

Loop

' Restore original values because this is a demonstration.

rstTitles.MoveFirst

Do Until rstTitles.EOF

If Trim(rstTitles!Type) = "self_help" Then

rstTitles!Type = "psychology"

End If

rstTitles.MoveNext

Loop

rstTitles.UpdateBatch

rstTitles.Close

End Sub

$ Append and CreateParameter Methods Example (ADO)

$ AppendChunk and GetChunk Methods Example (ADO)

$ BeginTrans, CommitTrans, and RollbackTrans Methods Example (ADO)

A admthBeginTransX;admthCommitTransX;admthRollbackTransX;

$ Execute, Requery, and Clear Methods Example (ADO)

$ MoveFirst, MoveLast, MoveNext, and MovePrevious Methods Example (ADO)

A admthMoveFirstX;admthMoveLastX;admthMoveNextX;admthMovePreviousX;

$ Update and CancelUpdate Methods Example (ADO)

$ UpdateBatch and CancelBatch Methods Example (ADO)