![]() Visual Basic6 Database Programming For Dummies
ISBN: 978-0-7645-0625-3
Paperback
408 pages
September 1999
US $34.95
This price is valid for United States. Change location to view local pricing and availability. This is a Print-on-Demand title. It will be printed specifically to fill your order. Please allow an additional 1-2 days delivery time for paperbacks, and 3-5 days for hardcovers. The book is not returnable.
|
Companion Site
Below you will find all code listings for the book.
Chapter 1 Code Listings
There is no code for Chapter 1
Chapter 2 Code Listings
SELECT 'Name'
FROM Divorces
WHERE ('Year' BETWEEN 1989 AND 1991)
Chapter 3 Code Listings.
Private Sub Form_Load() Hide frmAuthors.Show End Sub
Chapter 4 Code Listings.
Private Sub Form_Load() Dim DE As New DataEnvironment1 DE.employees DE.rsEmployees.MoveFirst Do While DE.rsEmployees.EOF = False List1.AddItem DE.rsEmployees.Fields(1) DE.rsEmployees.MoveNext Loop End Sub DE.employees Dim cnn As ADODB.Connection Dim cmd As ADODB.Command Dim rs As ADODB.Recordset Private Sub Form_Load() Set cnn = DataEnvironment1.Connection1 Set cmd = New ADODB.Command Cnn.Open Set cmd.ActiveConnection = cnn cmd.CommandText = "Employees" cmd.CommandType = adCmdTable cmd.CommandTimeout = 15 Set rs = cmd.Execute() Do While Not rs.EOF List1.AddItem rs!LastName rs.MoveNext Loop rs.Close cnn.Close End Sub With Text1 Set .DataSource = DataEnvironment1 .DataMember = "Customers" .DataField = "ContactName" End With
Chapter 5 Code Listings.
Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Program Files\VB98 _ \Biblio.mdb;Persist;Security Info=False
Chapter 6 Code Listings.
Private Sub Form_Load() DataReport1.Show End Sub Private Sub Form_Load() DataReport1.Show MsgBox DataReport1.Sections(2).Name MsgBox DataReport1.Sections(2).Controls(2).Name End Sub Private Sub Form_Load() DataReport1.Show DataReport1.Title = "MARA LAGOON PROPERTIES" End Sub Private Sub Form_Load() DataReport1.Show End Sub
Chapter 7 Code Listings.
Private Sub Command2_Click() Data1.Recordset.MoveNext End Sub Private Sub Command1_Click() If Data1.Recordset.BOF = True Then Exit Sub Data1.Recordset.MovePrevious End Sub Private Sub Form_Activate() Do While Data1.Recordset.EOF = False List1.AddItem Data1.Recordset.Fields(1) Data1.Recordset.MoveNext Loop End Sub Provider=Microsoft.Jet.OLEDB.4.0;Data Source= _ C:\Program Files\VB98\Nwind.mdb;Persist Security Info=False Private Sub Command1_Click() MsgBox MaskEdBox1.Text MsgBox MaskEdBox1.FormattedText End Sub
Chapter 8 Code Listings.
Private Sub Form_Load() frmfrmCDs.Show End Sub
Chapter 9 Code Listings.
Private Sub Text1_LostFocus()L = Len(Text1) If L < 5 Then MsgBox "A zip code must be at least 5 characters long. _ But you! You entered only " & L & " characters. Do try again." End If End Sub Private Sub Text1_Validate(Cancel As Boolean) If Len(Text1) < 5 And Text1 <> "" Then MsgBox "Zip codes are 5 digits long. Try again please." Cancel = True End If End Sub
Chapter 10 Code Listings.
Public Property Get ProductName() As String
ProductName = txtName.Text
End Property
Public Property Let ProductName(ByVal newProductName As String)
txtName.Text = newProductName
End Property
Public Property Get ProductPrice() As String
ProductPrice = txtPrice.Text
End Property
Public Property Let ProductPrice(ByVal newProductPrice As String)
txtPrice.Text = newProductPrice
End Property
Public Property Get ProductID() As String
ProductID = txtID.Text
End Property
Public Property Let ProductID (ByVal newProductID As String)
txtID.Text = newProductID
End Property
Private Sub txtName_Change()
PropertyChanged "ProductName"
End Sub
Private Sub txtPrice_Change()
PropertyChanged "ProductPrice"
End Sub
Private Sub txtID_Change()
PropertyChanged "ProductID"
End Sub
Private Sub Form_Load()
Set ctlExtender = Controls.Add _
("Products.ctlProducts", "MyUserControl")
With ctlExtender
.Visible = True
.Top = 1200
.Left = 900
End With
End Sub
Dim ctlExtender As VBControlExtender
Licenses.Add "Products.ctlProducts", "TheLicensesKey"
Controls.Add("Products.ctlNewName", "MyUserControl")
Private Sub Form_Load()
Form1.Controls.Add "VB.TextBox", "cmdObj1"
With Form1!cmdObj1
.Visible = True
.Width = 3000
.Text = "I popped into existence!"
End With
End Sub
Chapter 11 Code Listings.
Private Sub Command1_Click() Text1 = Text1 * 1.07 End Sub Private Sub Form_Load() Command1.Left = Text1.Left End Sub Private Sub UserDocument_Initialize() Call Form_Load End Sub Private Sub UserDocument_Initialize() Command1.Left = Text1.Left End Sub <HTML> <HEAD> <TITLE>Project1.CAB</TITLE> </HEAD> <BODY> <a href=UserDocument1.VBD>UserDocument1.VBD</a>> </BODY> </HTML> Private Sub mnuMicrosoft_Click() Hyperlink.NavigateTo "http://www.microsoft.com" End Sub
Chapter 12 Code Listings.
function BlastIt()
Format C:\
end function
<body onload="BlastIt()">
<HTML>
<HEAD>
<SCRIPT LANGUAGE=vbscript>
a = 2 + 2
msgbox a
</SCRIPT>
</HEAD>
<BODY>
The result of 2 + 2.
</BODY>
</HTML>
<HTML>
<HEAD>
</HEAD>
<BODY>
AN ASP EXAMPLE
<BR>
<%
a = 2+2
response.write " The result of 2 + 2: "
response.write(a) %>
</BODY>
</HTML>
http://dell/DBDummies/test1.asp
<HTML>
<HEAD>
</HEAD>
<BODY>
<H2>Authors from the Biblio Database</H2>
<%
dim dbconnection
dim rsAuthors
set dbconnection = Server.CreateObject("ADODB.Connection")
dbconnection.open "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=C:\Program Files\VB98\biblio.mdb"
SQLQuery = "SELECT author FROM authors ORDER BY author"
set rsAuthors = dbconnection.Execute(SQLQuery)
do until rsAuthors.eof
n = n + 1
Response.Write n & ". "
Response.Write rsAuthors("Author?) %>
<BR>
<%
rsAuthors.movenext
loop
rsAuthors.close
set rsAuthors = nothing
%>
</BODY>
</HTML>
"Data Source=C:\Program Files\VB98\biblio.mdb"
Response.Write rsAuthors("Author") %>
<BR>
<%
Chapter 13 Code Listings.
Option Explicit
Option Compare Text
Private Sub WebClass_Start()
'Write a reply to the user
With Response
.Write "<html>"
.Write "<body>"
.Write "<h1><font face=""Arial""> _
WebClass1's Starting Page</font></h1>"
.Write "<p>This response was created in _
the Start event of WebClass1.</p>"
.Write "</body>"
.Write "</html>"
End With
End Sub
.Write "<h1><font face=""Arial"">Changes _
Can Be Made</font></h1>"
.Write "<BR><BR>"
.Write "<p>Please sign up for our trip to South _
Carolina's outer ridges.</p>"
<html>
<body>
<h1>The Happy Day Holiday Travel Agency Page!</h1>
<BR>
Today's Date: <WC@TD>Date</WC@TD>
<WC@mess>message</WC@mess>
</body>
</html>
Private Sub WebClass_Start()
happy.WriteTemplate
End Sub
Private Sub Happy_ProcessTag(ByVal TagName As String, _
TagContents As String, SendTags As Boolean)
TagName = LCase(TagName)
If TagName = "wc@td" Then TagContents = Now
If TagName = "wc@mess" Then
If Month(Now) < 6 Then
TagContents = "It's never too early "
Else
TagContents = "It's not too late "
End If
TagContents = TagContents & "to plan your winter getaway!"
End If
SendTags = False
End Sub
<html>
<body>
<BR><BR>
<h1 ALIGN=CENTER>PUBLISHERS</h1>
<BR>
<WC@Pubs></WC@Pubs>
</body>
</html>
Private Sub WebClass_Start()
Template1.WriteTemplate
End Sub
Private Sub Template1_ProcessTag(ByVal TagName As String, _
TagContents As String, SendTags As Boolean)
TagName = LCase(TagName)
If TagName = "wc@pubs" Then
TagContents = fnShowData
End If
SendTags = False
End Sub
Private Function fnShowData()
Dim cBiblio As ADODB.Connection
Dim rsPubs As ADODB.Recordset
Dim SQLQuery As String
Dim strData As String
Dim r As String
r = "Provider=microsoft.jet.OLEDB.3.51;" & "Data Source= _
C:\Program Files\Microsoft Visual Studio\VB98\biblio.mdb"
'make the connect to the biblio database
Set cBiblio = New ADODB.Connection
cBiblio.ConnectionString = r
cBiblio.Open
SQLQuery = "SELECT * FROM Publishers ORDER BY Name"
Set rsPubs = New ADODB.Recordset
rsPubs.Open SQLQuery, cBiblio
strData = "<TABLE BORDER=1 CELLPADDING=3>"
Do While Not rsPubs.EOF
strData = strData & "<TR><TD>" & _
rsPubs("Company Name") & "</TD><TD>" _
& rsPubs("Telephone") & "</TR>"
rsPubs.movenext
Loop
strData = strData & "</TABLE>"
fnShowData = strData
rsPubs.Close
Set rsPubs = Nothing
cBiblio.Close
Set cBiblio = Nothing
End Function
<html>
<body>
<BR>
<h3>You asked for further information about _
<WC@Co></WC@Co>:</h3>
<BR>
<WC@Info></WC@Info>
</body>
</html>
Dim strName As String
Dim strInfo As String
Private Sub Template2_ProcessTag(ByVal TagName As String, _
TagContents As String, SendTags As Boolean)
TagName = LCase(TagName)
If TagName = "wc@co" Then
TagContents = strName
End If
If TagName = "wc@info" Then
TagContents = strInfo
End If
SendTags = False
End Sub
strData = strData & "<TR><TD>" & rsPubs("Company Name") _
& "</TD><TD>" & rsPubs("Telephone") & "</TR>"
strData = strData & "<TR><TD><A HREF=" _
& URLFor(WebItem1, n) & ">" & rsPubs("Company Name") _
& "</A></TD><TD></TR>"
Do While Not rsPubs.EOF
Do While Not rsPubs.EOF
n = rsPubs("Company Name")
Dim r As String
Dim r As String
Dim n As String
Private Sub WebItem1_UserEvent(ByVal EventName As String)
Dim cBiblio As ADODB.Connection
Dim rsPubs As ADODB.Recordset
Dim SQLqry As String
Dim r As String
r = "Provider=microsoft.jet.OLEDB.3.51;" _
& "Data Source=C:\Program Files\Microsoft Visual Studio\VB98\biblio.mdb"
Set cBiblio = New ADODB.Connection
cBiblio.ConnectionString = r
cBiblio.Open
SQLqry = "SELECT * FROM Publishers WHERE [Company Name] = '" & EventName & "'"
Set rsPubs = New ADODB.Recordset
rsPubs.Open SQLqry, cBiblio
strName = rsPubs("Company Name")
If IsNull(rsPubs("Telephone")) Then
strInfo = "There is no telephone number provided for this company in the database."
Else
strInfo = "Their telephone number is: " & rsPubs("Telephone")
End If
Template2.WriteTemplate
rsPubs.Close
Set rsPubs = Nothing
cBiblio.Close
Set cBiblio = Nothing
End Sub
Chapter 15 Code Listings.
There is no code for chapter 15 available.
Chapter 16 Code Listings.
Dim dbBiblio As Database ADOrecordset.Find SQLQuery, adSearchForward Dim cnBiblio As ADODB.connection Dim rsTitles As ADODB.Recordset Dim SQLQuery As String Private Sub Form_Load() Set cnBiblio = New ADODB.connection Set rsTitles = New ADODB.Recordset cnBiblio.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51; Data Source=C:\PROGRAM FILES\VB98\BIBLIO.MDB" cnBiblio.open SQLQuery = "SELECT * FROM Titles ORDER BY Title" rsTitles.open SQLQuery, cnBiblio MsgBox rsTitles!Title End Sub rsTitles.open "Titles", cnBiblio cnBiblio.open "Provider=Microsoft.Jet.OLEDB.3.51; Data Source=C:\PROGRAM FILES\VB98\BIBLIO.MDB" Dim cnBiblio As ADODB.connection Dim rsTitles As ADODB.Recordset Private Sub Form_Load() Set cnBiblio = New ADODB.connection Set rsTitles = New ADODB.Recordset cnBiblio.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51; Data Source=C:\PROGRAM FILES\VB98\BIBLIO.MDB" cnBiblio.open SQLQuery = "SELECT * FROM Titles ORDER BY Title" rsTitles.open SQLQuery, cnBiblio End Sub Private Sub Command1_Click() On Error Resume Next List1.Clear SQLQuery = "Title LIKE ?*" & Text1 & "*?" Do Until rsTitles.EOF = True rsTitles.Find SQLQuery, adSearchForward List1.AddItem rsTitles!Title rsTitles.MoveNext Loop End Sub rsTitles.FindNext SQLQuery ?DAO rsTitles.Find SQLQuery, adSearchForward ?ADO Dim cnBiblio As ADODB.connection Dim rsFields As ADODB.Recordset Private Sub Form_Load() Dim sTable As String Dim sNewTable As String Set cnBiblio = New ADODB.connection cnBiblio.ConnectionString = "Provider=Microsoft.Jet.OLEDB _ .3.51; Data Source=C:\PROGRAM FILES\VB98\BIBLIO.MDB" cnBiblio.open Set rsSchema = cnBiblio.OpenSchema(adSchemaColumns) Do Until rsSchema.EOF = True sTable = rsSchema!Table_Name If Left(sTable, 4) = "MSys" Then GoTo KeepMoving If (sTable <> sNewTable) Then List1.AddItem "" ?Insert blank line sNewTable = rsSchema!Table_Name List1.AddItem " TABLE: " & sNewTable End If List1.AddItem rsSchema!Column_Name KeepMoving: rsSchema.MoveNext Loop CnBiblio.Close End Sub If Left(sTable, 4) = "MSys" Then GoTo KeepMoving Dim cnBiblio As ADODB.connection Dim rsFields As ADODB.Recordset Private Sub Form_Load() On Error Resume Next Dim sTable As String Dim sNewTable As String Set cnBiblio = New ADODB.connection cnBiblio.ConnectionString = "Provider=Microsoft.Jet. _ OLEDB.3.51; Data Source=E:\PROGRAM FILES\VB98\BIBLIO.MDB" cnBiblio.open Set rsSchema = cnBiblio.OpenSchema(adSchemaProviderTypes) Do Until rsSchema.EOF = True dt = rsSchema!Type_Name cs = rsSchema!Column_Size List1.AddItem "Data Type: " & dt & " Column Size: " & cs rsSchema.MoveNext Loop CnBiblio.Close End Sub YourRecordsetsName.Open "SELECT * FROM TITLES, _ YourDataConnectionsName, adOpenDynamic, adLockOptimistic
Chapter 17 Code Listings.
Private Sub Form_Load()
Dim db As Database
On Error GoTo ErrorHandler
Set db = OpenDatabase("ZZTop")
Exit Sub
ErrorHandler:
Dim E As Error
For Each E In Errors
z = z + 1
With E
strError = _
"Error #" & .Number & vbCr
strError = strError & _
"Description: " & .Description & vbCr
strError = strError & _
"Source: " & .Source & vbCr
strError = strError & _
"HelpContext " & .HelpContext & vbCr
strError = strError & _
"HelpFile " & .HelpFile & "."
End With
MsgBox "Problem #" & z & vbCr & " " & strError
Next
Resume Next
End Sub
Private Sub Form_Load()
Dim cn As ADODB.Connection
On Error GoTo ErrorHandler
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft. _
Jet.OLEDB.3.51; Data Source=C:\MysteryFolder\VB98\Biblio.mdb"
cn.open
Exit Sub
ErrorHandler:
?Dim ECollection As Variant
Dim E As Error
Set ECollection = cn.Errors
For Each E In ECollection
z = z + 1
With E
strError = _
"Error #" & .Number & vbCr
strError = strError & _
"Description: " & .Description & vbCr
strError = strError & _
"Source: " & .Source & vbCr
strError = strError & _
"HelpContext " & .HelpContext & vbCr
strError = strError & _
"HelpFile " & .HelpFile & "."
End With
MsgBox "Problem #" & z & vbCr & " " & strError
Next
Resume Next
End Sub
Dim cn As ADODB.Connection
If rsTitles.EOF = True And rsTitles.BOF = True Then Exit Sub
rsTitles.MovePrevious
Private Sub Form_Load()
On Error GoTo ErrorHandler
Dim rsTitles As Recordset
Set dbBiblio = opendatabase("C:\program files\vb98\biblio.mdb")
SQLQuery = "SELECT * FROM Titles WHERE Title LIKE ?*CZX*?"
Set rsTitles = dbBiblio.OpenRecordset(SQLQuery)
rsTitles.MovePrevious
Exit Sub
ErrorHandler:
If Err = 3021 Then
Exit Sub
Else
Msgbox Error(Err)
End If
End Sub
List1.AddItem rsState.Fields("State")
a = Mid("Saer", 0, 1)
Sub LockControls()
a = InStr("Saer", 0, 1)
End Sub
Private Sub Form_Load()
m = 12.56
End Sub
a = InStr("Saer", "aer")
Sub LockControls()
a = 1 + 1
End Sub
Private Sub Form_Load()
b = 1 + 1
End Sub
Sub Stop
Private Sub Form_Click()
Dim textObj As TextBox
textObj.Text = "Changed!"
End Sub
Private Sub Form_Click()
Dim textObj As TextBox
Set textObj = Text1
textObj.Text = "Changed!"
End Sub
Private Sub Form_Load()
Data1.Recordset.MoveNext
End Sub
Private Sub Form_Activate()
Data1.Recordset.MoveNext
End Sub
Dim dbBiblio As Database
Private Sub Form_Load()
Set dbBiblio = opendatabase("C:\PROGRAM FILES\VB98\BIBLIO.MDB")
Set rsTitles = dbBiblio.OpenRecordset("Publishers")
Text1 = rsTitles.Fields("Comments")
End Sub
Text1 = rsTitles.Fields("Comments")
Text1 = rsTitles.Fields("Comments") & ""
Chapter 18 Code Listings.
SELECT * FROM Publishers WHERE State LIKE 'CA' ORDER BY 'PubName'
SELECT Author
FROM Authors
WHERE (Author > 'P')
WHERE Authors.Au_ID = 'Title Author'.Au_ID
WHERE Authors.Au_ID = 'Title Author'.Au_ID
WHERE Authors.Au_ID = 'Title Author'.Au_ID AND 'Title Author'.ISBN = Titles.ISBN
SELECT * from Publishers WHERE Name = "IDG"
Private Sub Command1_Click()
Dim db As Database
Set db = OpenDatabase("C:\Program Files\VB98\BIBLIO.MDB")
Dim rs As Recordset
Dim qd As querydef
Set qd = db.QueryDefs("qryIDG")
Set rs = qd.OpenRecordset
Do Until rs.EOF
List1.AddItem rs!Name
rs.MoveNext
Loop
End Sub
Private Sub Command1_Click()
Dim db As Database
Dim qd As querydef
Set db = OpenDatabase("C:\Program Files\VB98\BIBLIO.MDB")
Set qd = db.CreateQueryDef("qryIDG2", "SELECT * from Publishers WHERE Name = 'IDG'")
End Sub
Chapter 19 Code Listings.
SELECT Author FROM Authors
SELECT *
FROM Authors
SELECT [Au_ID],[Author]
FROM Authors
SELECT Author
FROM Authors
ORDER BY Author
SELECT FirstName,LastName,Phone
FROM Contacts
ORDER BY LastName,FirstName
SELECT Author
FROM Authors
WHERE (Author LIKE 'Albrecht%')
SELECT `Year Published`
FROM Titles
WHERE (`Year Published` BETWEEN 1993 AND 1995)
BETWEEN #1993# AND #1995#
WHERE (Author LIKE 'ab%')
SELECT Author
FROM Authors
WHERE (Author LIKE 'ab%')
SELECT Author
FROM Authors
ORDER BY Author
ORDER BY Author DESC
ORDER BY LastName, FirstName
ORDER BY LastName DESC, FirstName
ORDER BY LastName DESC, FirstName DESC
SELECT TOP 25 *
FROM tblSales
ORDER BY TotalSales DESC
SELECT TOP 5 PERCENT *
FROM tblSales
ORDER BY TotalSales DESC
SELECT Authors.Author, 'Title Author'.ISBN
FROM Authors, 'Title Author'
WHERE Authors.Au_ID = 'Title Author'.Au_ID
SELECT Author, ISBN
FROM Authors LEFT JOIN
'Title Author' ON
Authors.Au_ID = 'Title Author'.Au_ID
SELECT tblAu AS 'Author Name'
FROM Authors
SELECT DISTINCT City
FROM Publishers
SELECT Author
FROM Authors
SELECT COUNT(Author) AS Expr1
FROM Authors
SELECT COUNT(Author) AS 'Total Authors'
FROM Authors
SELECT COUNT(City) AS Total, City
FROM Publishers
GROUP BY City
SELECT COUNT(City) AS Total, City
FROM Publishers
GROUP BY City
HAVING (City LIKE 'S%')
DELETE * FROM Authors
DELETE Author
FROM Authors
WHERE (Author LIKE 'A%')
SQLAction = "UPDATE Publishers SET State _
= *** STET ***'Penn' WHERE State = 'Pa'"
dbBIBI.Execute SQLAction
Dim dbBIBI As Database
Dim rsState As Recordset
Private Sub Form_Load()
Dim rsState As Recordset
Set dbBIBI = OpenDatabase("C:\PROGRAM _
FILES\VB98\BIBI.MDB")
SQLQuery = "SELECT * FROM Publishers WHERE _
State LIKE 'Pa*'"
Set rsState = dbBIBI.OpenRecordset(SQLQuery)
Do Until rsState.EOF = True
List1.AddItem rsState.Fields("State")
rsState.MoveNext
Loop
Set rsState = Nothing
End Sub
Private Sub Command1_Click()
SQLAction = "UPDATE Publishers SET State _
= ?Pann' WHERE State = ?Pa?"
dbBIBI.Execute SQLAction
dbBIBI.Close
Set dbBIBI = Nothing
End Sub
Update tblOrders
SET StateTax = StateTax * 1.01
Update tblOrders
SET StateTax = StateTax * 1.01
WHERE StateTax < 5
INSERT INTO Authors(Author, [Year Born])
VALUES(?Aadersen, Sven?, 1899)
Private Sub Form_Load()
Dim dbBIBLIO As Database
Set dbBIBLIO = OpenDatabase("C:\PROGRAM FILES _
\VB98\BIBLIO.MDB")
sqlaction = "INSERT INTO Authors(Author, _
[Year Born]) VALUES(?Aadersen, Sven?, 1899)"
dbBIBLIO.Execute sqlaction
dbBIBLIO.Close
End Sub
Private Sub Form_Load()
Dim dbBIBLIO As Database
Dim rsAuthor As Recordset
Set dbBIBLIO = OpenDatabase("C:\PROGRAM FILES _
\VB98\BIBLIO.MDB")
SQLQuery = "SELECT * FROM Authors WHERE _
Author LIKE ?a*? ORDER BY Author"
Set rsAuthor = dbBIBLIO.OpenRecordset(SQLQuery)
Do Until rsAuthor.EOF = True
List1.AddItem rsAuthor.Fields("Author")
rsAuthor.MoveNext
Loop
Set rsAuthor = Nothing
End Sub
INSERT INTO tblNewTable
SELECT * FROM tblExistingTable
INSERT INTO tblNewTable
SELECT * FROM tblExistingTable
WHERE Quantity > 2000
SELECT * INTO tblNewTable
FROM tblExistingTable

