Page 1
Page 2
Page 3
That concludes our simple tutorial on how to add and
delete a database, create and drop tables and insert data into a table.
This is a complete listing of the code for your reference,
in addition you can download the project
files here. If you have any questions regarding this tutorial please post
them in the eVB
Databases forum.
General Declarations
Option Explicit
Const gDBFileSpec = "\My Documents\drmtest.cdb"
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3
Const adLockReadOnly = 1
Const adLockPessimistic = 2
Const adLockOptimistic = 3
Public conn As ADOCE.Connection
Checking whether the database exists
Private Function DBExists(paramFileSpec As String) As
Boolean
'this function checks whether the database exists
If FileSystem1.Dir(paramFileSpec) <> "" Then
DBExists = True
Else
DBExists = False
End If
End Function
Create Database
Private Sub cmdCreateDB_Click()
Dim rs, rc
'this sub creates a database
'using the gDBFileSpec
'if it exists ask re deletion
If DBExists(gDBFileSpec) = True Then
rc = MsgBox("Overwrite database " & gDBFileSpec
& " ?", vbYesNoCancel, "Database already exists")
If rc = vbYes Then
'clean up current database connection
connClose
'delete the file
FileSystem1.Kill gDBFileSpec
txtDB.Text = gDBFileSpec & " deleted!"
Else
Exit Sub
End If
End If
'go ahead and create the database
On Error Resume Next
Set rs = CreateObject("ADOCE.Recordset.3.0")
rs.Open "CREATE DATABASE '" & gDBFileSpec & "'"
rs.Close
Set rs = Nothing
On Error GoTo 0
If DBExists(gDBFileSpec) = True Then
txtDB.Text = gDBFileSpec & " created!"
End If
End Sub
Delete Database
Private Sub cmdDeleteDB_Click()
Dim rc, rs
'this sub deletes the database
'found at gDBFileSpec
If DBExists(gDBFileSpec) = True Then
rc = MsgBox("Delete database " & gDBFileSpec
& " ?", vbYesNoCancel, "Delete database")
If rc = vbYes Then
'clean up current database connection
connClose
'go ahead and delete the database
On Error Resume Next
Set rs = CreateObject("ADOCE.Recordset.3.0")
rs.Open "DROP DATABASE '" &
gDBFileSpec & "'"
'no need to rs.Close since no rs was returned
Set rs = Nothing
On Error GoTo 0
Else
Exit Sub
End If
End If
If DBExists(gDBFileSpec) = False Then
txtDB.Text = gDBFileSpec & " deleted!"
End If
End Sub
Creating a Table
Private Sub cmdCreateTbl_Click()
ExecSQL "CREATE table TestTable (fldTxt text, fldInt integer)",
"TestTable created.", "Err: TestTable was not created."
End Sub
Inserting Table Rows
Private Sub cmdInsertRows_Click()
Dim rs As ADOCE.Recordset
Dim arb1 As Integer
If connOpen = True Then
Set rs = CreateObject("ADOCE.Recordset.3.0")
On Error Resume Next
rs.Open "TestTable", conn, adOpenKeyset, adLockOptimistic
For arb1 = 1 To 5
rs.AddNew
rs.Fields("fldTxt") = CStr(arb1)
rs.Fields("fldInt") = arb1
rs.Update
Next
If conn.Errors.Count = 0 Then
txtDB.Text = CStr(rs.RecordCount) &
" rows were added to TestTable."
Else
DispErrors
txtDB.Text = "There were errors adding
rows to TestTable."
End If
On Error GoTo 0
rs.Close
connClose
End If
End Sub
Listing the Table Rows
Private Sub cmdListRows_Click()
Dim rs As ADOCE.Recordset
Dim cnt As Integer
Dim strDisp As String
Dim arb2 As Integer
If connOpen = True Then
List1.Clear
Set rs = CreateObject("ADOCE.Recordset.3.0")
On Error Resume Next
rs.Open "select * from TestTable", conn,
adOpenForwardOnly, adLockReadOnly
Do While Not rs.EOF
'Method 1
'comment out line below if using Method
2
strDisp = rs(0).Name & ": "
& rs(0).Value
'Method 2
'comment out lines below if using Method
1
'add all field data
'strDisp = ""
'For arb2 = 0 To rs.Fields.Count
' strDisp = strDisp & rs.Fields(arb2).Value
& " : "
'Next
List1.AddItem strDisp
rs.MoveNext
Loop
cnt = rs.RecordCount
rs.Close
Set rs = Nothing
txtDB.Text = cnt & " rows were listed in
TestTable."
On Error GoTo 0
End If
connClose
End Sub
Deleting Table Rows
Private Sub cmdDeleteRows_Click()
ExecSQL "delete from TestTable", "All rows in TestTable
were deleted.", "Err: the rows in TestTable were not deleted."
End Sub
Delete the Table
Private Sub cmdDeleteTbl_Click()
ExecSQL "DROP table TestTable", "TestTable dropped.",
"Err: TestTable was not dropped."
End Sub
Form Load Event
Private Sub Form_Load()
If DBExists(gDBFileSpec) = True Then
txtDB.Text = "The test database has been created."
Else
txtDB.Text = "Start by creating the database."
End If
End Sub
Form OK Click Event
Private Sub Form_OKClick()
App.End
End Sub
ExecSQL
Function ExecSQL(paramSQL As String, paramSuccess As
String, paramErr As String) As Boolean
If DBExists(gDBFileSpec) = True Then
connOpen
On Error Resume Next
conn.Execute (paramSQL)
On Error GoTo 0
'check for errors
If conn.Errors.Count > 0 Then
'DispErrors
ExecSQL = False
txtDB.Text = paramErr
Else
ExecSQL = True
txtDB.Text = paramSuccess
End If
connClose
Else
MsgBox "Database " & gDBFileSpec &
" does not exist!", vbOKOnly, "No database"
End If
End Function
Open a database connection
Function connOpen() As Boolean
On Error Resume Next
connOpen = True
If conn Is Nothing Then
Set conn = CreateObject("ADOCE.Connection.3.0")
conn.Open gDBFileSpec
If conn.Errors.Count > 0 Then
MsgBox "errors in connOpen", vbOKOnly
DispErrors
'connClose
connOpen = False
End If
End If
On Error GoTo 0
End Function
Closing the database connection
Sub connClose()
On Error Resume Next
conn.Close
Set conn = Nothing
On Error GoTo 0
End Sub
Displaying Errors
Sub DispErrors()
Dim dispErr As String
Dim arb1 As Integer
Dim arb2 As Integer
Dim ADOErr As ADOCE.Error
'show connections errors
For arb1 = 0 To conn.Errors.Count - 1
Set ADOErr = conn.Errors(arb1)
dispErr = "desc = " & ADOErr.Description
& vbCrLf
dispErr = dispErr & "number = " &
Hex(ADOErr.Number) & vbCrLf
dispErr = dispErr & "nativeerror = " &
ADOErr.NativeError & vbCrLf
dispErr = dispErr & "source = " &
ADOErr.Source
MsgBox dispErr, vbCritical, strTitleBar
Next arb1
End Sub
Previous Page