Congratulations on writing your first procedure!
I would enjoy hearing two things. Will this code work? What are your
suggestions? I added _ line breaks hoping it translates properly for
email.
Not in it's present form. It appears as if you split the lines of code and
added the line breaks after pasting the code into a new message. The
reason I
say this is that a direct copy and paste of your code into a new form
module
resulted in several lines shown in red font (errors). After fixing this
problem, I added three Debug.Print statements and ran the code:
Debug.Print strSQLHomePhone
Debug.Print strSQLCellPhone
Debug.Print strSQLParentPhone
The resulting SQL statements are not valid. In each case, there is an
extra
two opening parentheses that are not balanced with matching closing
parentheses:
WHERE (((People
The solution is to simply eliminate two of these in each of the three
statements, so that you end up with, for example:
& " WHERE (People.[Home Phone]) IS NOT NULL"
=======================================
The next problem became evident after I ran your code, after inserting
some
test data into the People table. I had added the following data into this
table:
ID Home Phone Cell Phone Parents Phone
1 11111 22222 33333
2 44444
3 55555
4 66666
This produced the following result in the PhoneComm table:
People ID Contact ID PhoneComm
1 9 33333
1 9 33333
1 3 22222
1 1 11111
2 1 44444
3 3 55555
4 9 66666
Notice that there are (7) new records, where there should only be (6) new
records. One of the records is duplicated. The reason for this is the Left
Joins that you used:
"Include ALL records from 'People' and only those records from 'PhoneComm'
where the joined fields are equal."
The trouble is that the third SQL Insert statement, for this sample of
data
in the People table, results in three records being inserted instead of
just
two:
1 9 33333
1 9 33333
4 9 66666
The reason is that you already had two records inserted into the PhoneComm
table at this point, with PeopleID = 1. You do not need to include the
PhoneComm table in the join. Change the three lines of code under this
comment, as indicated below:
'FROM People LEFT JOIN PhoneComm ON People.ID = PhoneComm.[People ID]
strSQLHomePhone = strSQLHomePhone & " FROM People"
strSQLCellPhone = strSQLCellPhone & " FROM People"
strSQLParentPhone = strSQLParentPhone & " FROM People"
=======================================
Declaration of variables
Dim strSQLHomePhone, strSQLCellPhone, strSQLParentPhone As String
Only the last variable indicated, strSQLParentPhone is initially typecast
as
a string variable. The other two variables are initially created as empty
variants. You should always typecast your variables. Use one of the
following
forms:
All on one line (this will be word wrapped in this reply):
Dim strSQLHomePhone As String, strSQLCellPhone As String,
strSQLParentPhone
As String
or, as three separate lines of code:
Dim strSQLHomePhone As String
Dim strSQLCellPhone As String
Dim strSQLParentPhone As String
=======================================
Insert error handling code.
Pretty much all procedures should include code to handle errors. A basic
skeleton is as follows.
Option Compare Database
Option Explicit
Private Sub btnMovePhones_Click()
On Error GoTo ProcError
:
Your code goes here
:
ExitProc:
Exit Sub
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure btnMovePhones_Click..."
Resume ExitProc
End Sub
Note:
If you do not have the two very important words "Option Explicit" shown as
the second line of code at the top of all modules, then add it. This link
explains why this statement is so important, and how to configure your
Visual
Basic Editor (VBE) to include it in all new modules:
Always Use Option Explicit
http://www.access.qbuilt.com/html/gem_tips.html#VBEOptions
=======================================
'Hide Warnings and Execute SQL
DoCmd.SetWarnings False
Setting warnings to false can be dangerous. The reason is that if one of
the
lines of code that follows this statement fails, before the line of code
that
sets warnings back on is executed, then warnings will be left off for the
user. If you must set warnings to false, then make sure to turn them back
on
in the ExitProc section of your procedure. For example:
ExitProc:
DoCmd.SetWarnings True
Exit Sub
ProcError:
A better alternative for running action queries is the .execute method of
the current database. For example:
CurrentDB.Execute strSQLHomePhone, dbFailOnError
Notes:
1.) The use of the optional dbFailOnError parameter requires that you set
a
reference to the Microsoft DAO Object Library.
2.) Since you have more than one insert statement, it is more economical
to
set a variable equal to CurrentDB, instead of calling this three times.
For
example:
Dim db As DAO.Database
Set db = CurrentDB()
and then:
db.Execute strSQLHomePhone, dbFailOnError
db.Execute strSQLCellPhone, dbFailOnError
db.Execute strSQLParentPhone, dbFailOnError
This allows you to get rid of the DoCmd.SetWarning statements. You should
set this variable to nothing in the ExitProc section of your procedure.
For
example:
ExitProc:
Set db = Nothing
Exit Sub
ProcError:
For more information on this issue, you can download a Word document that
I
have made available in zipped form:
http://home.comcast.net/~tutorme2/samples/ActionQueryExamplesWithSetWarnings.doc
=======================================
Here are two forms of a revised procedure for you:
Form 1: Similar to the form you layed out:
Option Compare Database
Option Explicit
Private Sub btnMovePhones_Click()
On Error GoTo ProcError
'If Home Phone exists, move it to PhoneComm (1)
'If Cell Phone exists, move it to PhoneComm (3)
'If Parents Phone exists, move it to PhoneComm (9)
Dim db As DAO.Database
Dim strSQLHomePhone As String
Dim strSQLCellPhone As String
Dim strSQLParentPhone As String
Set db = CurrentDb()
strSQLHomePhone = "INSERT INTO PhoneComm " _
& "( [People ID], [Contact ID], PhoneComm )"
strSQLCellPhone = "INSERT INTO PhoneComm " _
& "( [People ID], [Contact ID], PhoneComm )"
strSQLParentPhone = "INSERT INTO PhoneComm " _
& "( [People ID], [Contact ID], PhoneComm )"
'SELECT People.ID, (x), People.[xxx Phone]
strSQLHomePhone = strSQLHomePhone _
& " SELECT People.ID AS [People ID], " _
& "1 AS [Contact ID], People.[Home Phone] AS PhoneComm"
strSQLCellPhone = strSQLCellPhone _
& " SELECT People.ID AS [People ID], " _
& "3 AS [Contact ID], People.[Cell Phone] AS PhoneComm"
strSQLParentPhone = strSQLParentPhone _
& " SELECT People.ID AS [People ID], " _
& "9 AS [Contact ID], People.[Parents Phone] AS PhoneComm"
'FROM People
strSQLHomePhone = strSQLHomePhone & " FROM People"
strSQLCellPhone = strSQLCellPhone & " FROM People"
strSQLParentPhone = strSQLParentPhone & " FROM People"
'WHERE (((People.[xxx Phone]) Is Not Null));
strSQLHomePhone = strSQLHomePhone _
& " WHERE (People.[Home Phone]) IS NOT NULL"
strSQLCellPhone = strSQLCellPhone _
& " WHERE (People.[Cell Phone]) IS NOT NULL"
strSQLParentPhone = strSQLParentPhone _
& " WHERE (People.[Parents Phone]) IS NOT NULL"
'Execute SQL Inserts
db.Execute strSQLHomePhone, dbFailOnError
db.Execute strSQLCellPhone, dbFailOnError
db.Execute strSQLParentPhone, dbFailOnError
'Notify user
MsgBox "All records successfully inserted.", vbInformation, "Finished..."
ExitProc:
Set db = Nothing
Exit Sub
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure btnMovePhones_Click..."
Resume ExitProc
End Sub
================================
Form 2: Create and execute each SQL statement in order
Option Compare Database
Option Explicit
Private Sub btnMovePhones_Click()
On Error GoTo ProcError
'If Home Phone exists, move it to PhoneComm (1)
'If Cell Phone exists, move it to PhoneComm (3)
'If Parents Phone exists, move it to PhoneComm (9)
Dim db As DAO.Database
Dim strSQL As String
Set db = CurrentDb()
'Insert Home Phone numbers first
strSQL = "INSERT INTO PhoneComm " _
& "([People ID], [Contact ID], PhoneComm) " _
& "SELECT People.ID AS [People ID], " _
& "1 AS [Contact ID], People.[Home Phone] AS PhoneComm " _
& "FROM People " _
& "WHERE (People.[Home Phone]) IS NOT NULL"
db.Execute strSQL, dbFailOnError
'Insert Cell Phone numbers next
strSQL = "INSERT INTO PhoneComm " _
& "([People ID], [Contact ID], PhoneComm) " _
& "SELECT People.ID AS [People ID], " _
& "3 AS [Contact ID], People.[Cell Phone] AS PhoneComm " _
& "FROM People " _
& "WHERE (People.[Cell Phone]) IS NOT NULL"
db.Execute strSQL, dbFailOnError
'Insert Parents Phone numbers last
strSQL = "INSERT INTO PhoneComm " _
& "([People ID], [Contact ID], PhoneComm) " _
& "SELECT People.ID AS [People ID], " _
& "9 AS [Contact ID], People.[Parents Phone] AS PhoneComm " _
& "FROM People " _
& "WHERE (People.[Parents Phone]) IS NOT NULL"
db.Execute strSQL, dbFailOnError
'Notify user
MsgBox "All records successfully inserted.", vbInformation, "Finished..."
ExitProc:
Set db = Nothing
Exit Sub
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure btnMovePhones_Click..."
Resume ExitProc
End Sub
Hope you found this helpful.
Tom Wickerath
Microsoft Access MVP
https://mvp.support.microsoft.com/profile/Tom
http://www.access.qbuilt.com/html/expert_contributors.html
__________________________________________
wdsnews said:
Here is my first ever VBA code. I come from an ObjectPal background
where I
was very comfortable. But I'm new to Access, VBA, and SQL. This code is
attached to the 'Click On' event of a button to normalize data and turn a
flat file into a relational database. I would enjoy hearing two things.
Will this code work? What are your suggestions? I added _ line breaks
hoping it translates properly for email. Note that 'PhoneComm' is the
name
of a text field in a child table that is also named 'PhoneComm'. The
existing flat file is called 'People'.
Private Sub btnMovePhones_Click()
'If Home Phone exists, move it to PhoneComm (1)
'If Cell Phone exists, move it to PhoneComm (3)
'If Parents Phone exists, move it to PhoneComm (9)
Dim strSQLHomePhone, strSQLCellPhone, strSQLParentPhone As String
'INSERT INTO PhoneComm ( [People ID], [Contact ID], PhoneComm )
strSQLHomePhone = "INSERT INTO PhoneComm ( [People ID], [Contact ID],
PhoneComm )"
strSQLCellPhone = "INSERT INTO PhoneComm ( [People ID], [Contact ID],
PhoneComm )"
strSQLParentPhone = "INSERT INTO PhoneComm ( [People ID], [Contact ID],
PhoneComm )"
'SELECT People.ID, (x), People.[xxx Phone]
strSQLHomePhone = strSQLHomePhone & " SELECT People.ID AS _
[People ID], 1 AS [Contact ID], People.[Home Phone] AS PhoneComm"
strSQLCellPhone = strSQLCellPhone & " SELECT People.ID AS _
[People ID], 3 AS [Contact ID], People.[Cell Phone] AS PhoneComm"
strSQLParentPhone = strSQLParentPhone & " SELECT People.ID AS _
[People ID], 9 AS [Contact ID], People.[Parents Phone] AS PhoneComm"
'FROM People LEFT JOIN PhoneComm ON People.ID = PhoneComm.[People ID]
strSQLHomePhone = strSQLHomePhone & " FROM People LEFT JOIN _
PhoneComm ON People.ID = PhoneComm.[People ID]"
strSQLCellPhone = strSQLCellPhone & " FROM People LEFT JOIN _
PhoneComm ON People.ID = PhoneComm.[People ID]"
strSQLParentPhone = strSQLParentPhone & " FROM People LEFT JOIN _
PhoneComm ON People.ID = PhoneComm.[People ID]"
'WHERE (((People.[xxx Phone]) Is Not Null));
strSQLHomePhone = strSQLHomePhone & " WHERE (((People.[Home Phone]) _
IS NOT NULL"
strSQLCellPhone = strSQLCellPhone & " WHERE (((People.[Cell Phone]) _
IS NOT NULL"
strSQLParentPhone = strSQLParentPhone & " WHERE (((People.[Parents
Phone]) _
IS NOT NULL"
'Hide Warnings and Execute SQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQLHomePhone
DoCmd.RunSQL strSQLCellPhone
DoCmd.RunSQL strSQLParentPhone
DoCmd.SetWarnings True
End Sub
Thanks for your comments.
