Visual Basic6 Database Programming For Dummies

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