Visual Basic 6 Database Programming For DummiesISBN: 978-0-7645-0625-3
Paperback
408 pages
September 1999
This is a Print-on-Demand title. It will be printed specifically to fill your order. Please allow an additional 10-15 days delivery time. 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