Append loop working but causing duplicates - I'm lost

  • Thread starter Thread starter Billp
  • Start date Start date
B

Billp

Hi,

Trying and stretching my knowledge and skills to no avail at present.
The code loops but duplicates - so here is breifly a what is supposed to
happen.
I have a continuous form to which records are added.
Upon clicking a command button those records which visible are appended to
another table.
If the record showing has no matching parent in the other table a new parent
record is created and the record is appended.
If the parent record is in existance just append.
Continue doing thsi untill the visible records are finished.
With each record appended tick to say that it has been sent.
requery the form and because it has a base query set that the tick is false
no records will be shown.

Now here is the problem it loops nut also duplicates the records already in
existance on the other table - Here is what I have:

Private Sub CmdUpload_Button_Click()
On Error GoTo Err_CmdUpload_Button_Click
Me.Refresh
Dim strsql As String
Dim strsqlPack As String 'packingSlip table
Dim strsqlTick As String
Dim strOtherFields As String
Dim strOtherFieldsWC As String

Dim db As DAO.Database
Dim rst As DAO.Recordset 'first loop
Dim rst1 As DAO.Recordset

'*****************************************************************************
'find the first unchecked record - first loop
Set rst = Forms!frmProjectNotes_Input.RecordsetClone 'this is the visible
forms recorset
If rst.RecordCount > 0 Then 'there are some records showing
'remember that the form only shows records that are not checked
'as its based on a query.

Do While Not rst.EOF 'do until the end of the records showing
'for each record first check
'if there is a current Project Notes Form in existance
'and already associated with the visible records WCard Number
'if there is, update the note by appending it,
'if not create a new form associated with the WCard Number

Set db = CurrentDb
Set rst1 = db.OpenRecordset("tblProjectNotes", dbOpenDynaset)
rst1.FindFirst "Works_Number = """ & rst!Works_Number & """" 'check
the existing table

If rst1.NoMatch Then 'The return value is a Boolean that is True if
the desired record was not found.
'the Works Number number is not in the table
'therefore create a new notes entry for that
WCard number

strOtherFieldsWC = ",Company_Name"

strsqlPack = "INSERT INTO [tblProjectNotes] " _
& "(Works_Number" & strOtherFieldsWC & ") " _
& "SELECT '" & rst!Works_Number & "' As
NewWorks_Number" _
& strOtherFieldsWC & " FROM tblWorksCard " _
& "WHERE Works_Number='" & rst!Works_Number & "';"

DBEngine(0)(0).Execute strsqlPack, dbFailOnError

'we have created the new entry now we should update the
notes
strOtherFields = ",Action_By,To_Do_date" _
& ",Project_Notes,Status"

strsql = "INSERT INTO [tblsubProjectNotes] " _
& "(Works_Number" & strOtherFields & ") " _
& "SELECT '" & rst!Works_Number & "' As
NewWorks_Number" _
& strOtherFields & " FROM tblProjectNotes_Input " _
& "WHERE Works_Number='" & rst!Works_Number & "';"

strsqlTick = "UPDATE [tblProjectNotes_Input]" & _
"SET tblProjectNotes_Input.Sent_Input = True
" & _
"WHERE Works_Number='" & rst!Works_Number &
"';"


DBEngine(0)(0).Execute strsql, dbFailOnError
'remember to check all of these records as having been
sent
DBEngine(0)(0).Execute strsqlTick, dbFailOnError
'Next - Done with this record move to the next record
visible

Else 'there is a match - the WCard number is in the Packing
List Table
'so append the note and goto the next record

strOtherFields = ",Action_By,To_Do_date" _
& ",Project_Notes,Status"

strsql = "INSERT INTO [tblsubProjectNotes] " _
& "(Works_Number" & strOtherFields & ") " _
& "SELECT '" & rst!Works_Number & "' As
NewWorks_Number" _
& strOtherFields & " FROM tblProjectNotes_Input " _
& "WHERE Works_Number='" & rst!Works_Number & "';"

strsqlTick = "UPDATE [tblProjectNotes_Input]" & _
"SET tblProjectNotes_Input.Sent_Input = True
" & _
"WHERE Works_Number='" & rst!Works_Number &
"';"


DBEngine(0)(0).Execute strsql, dbFailOnError
'remember to check all of these records as having been sent
DBEngine(0)(0).Execute strsqlTick, dbFailOnError
'Next - Done with this record move to the next record
visible


End If
rst1.Close 'clear the recorset for new start
rst.MoveNext 'move now to the next record in the recordset
Loop 'start the checking etc for this new record
Else 'there are no entries ie the recordset has no entries to append
'or we have reached the End of the set
'do nothing
End If

rst.Close

Forms!frmProjectNotes_Input.Requery
Me.Requery


Exit_CmdUpload_Button_Click:
Set rst = Nothing
Set rst1 = Nothing
Set db = Nothing
Exit Sub

Err_CmdUpload_Button_Click:
msgbox Err.Description
Resume Exit_CmdUpload_Button_Click


End Sub

Any help or guidance and advice really really apprecaited
Thanks
Regards
 
Bill,

My first thought is that rather than inserting the current record into
tblProjectNotes, you are inserting the current record and any like it.
Instead of the Insert/SELECT syntax you are using, why don't you try using
the Values method below.

My next thought is that although you mention "no matching parent" in your
problem description, it doesn't look like your are checking for the parent in
the line of code that does the FindFirst. In most of my tables that are
hierarchical, I have a Parent_ID field or something like that. Shouldn't you
be looking for that field?

Is Works_Number a string? Why would you give a field a name that implies it
is a number, and then make it a text datatype? If it is a string, then you
will need to wrap the references to rst!Works_Number in quotes.

I have a function I use that makes this easy:

Public Function Quotes(SomeText as Variant) as String
Quotes = chr$(34) & (SomeText & "") & chr$(34)
End Function

strtSQLPack = "INSERT INTO [tblProjectNotes] " _
& "(Works_Number" & strOtherFieldsWC & ") " _
& "VALUES (" & rst!Works_Number & ", " _
& Quotes(rst!Company_Name) & ")"

and then for the second one:

strsql = "INSERT INTO [tblsubProjectNotes] " _
& "(Works_Number" & strOtherFields & ") " _
& "Values (" & rst!Works_Number & ", " _
& quotes(rst!Action_By) & ", " _
& "#" & rst!To_Do_Date & "#, " _
& quotes(rst!Project_Notes) & ", " _
& rst!Status & ")"


----
HTH
Dale



Billp said:
Hi,

Trying and stretching my knowledge and skills to no avail at present.
The code loops but duplicates - so here is breifly a what is supposed to
happen.
I have a continuous form to which records are added.
Upon clicking a command button those records which visible are appended to
another table.
If the record showing has no matching parent in the other table a new parent
record is created and the record is appended.
If the parent record is in existance just append.
Continue doing thsi untill the visible records are finished.
With each record appended tick to say that it has been sent.
requery the form and because it has a base query set that the tick is false
no records will be shown.

Now here is the problem it loops nut also duplicates the records already in
existance on the other table - Here is what I have:

Private Sub CmdUpload_Button_Click()
On Error GoTo Err_CmdUpload_Button_Click
Me.Refresh
Dim strsql As String
Dim strsqlPack As String 'packingSlip table
Dim strsqlTick As String
Dim strOtherFields As String
Dim strOtherFieldsWC As String

Dim db As DAO.Database
Dim rst As DAO.Recordset 'first loop
Dim rst1 As DAO.Recordset

'*****************************************************************************
'find the first unchecked record - first loop
Set rst = Forms!frmProjectNotes_Input.RecordsetClone 'this is the visible
forms recorset
If rst.RecordCount > 0 Then 'there are some records showing
'remember that the form only shows records that are not checked
'as its based on a query.

Do While Not rst.EOF 'do until the end of the records showing
'for each record first check
'if there is a current Project Notes Form in existance
'and already associated with the visible records WCard Number
'if there is, update the note by appending it,
'if not create a new form associated with the WCard Number

Set db = CurrentDb
Set rst1 = db.OpenRecordset("tblProjectNotes", dbOpenDynaset)
rst1.FindFirst "Works_Number = """ & rst!Works_Number & """" 'check
the existing table

If rst1.NoMatch Then 'The return value is a Boolean that is True if
the desired record was not found.
'the Works Number number is not in the table
'therefore create a new notes entry for that
WCard number

strOtherFieldsWC = ",Company_Name"

strsqlPack = "INSERT INTO [tblProjectNotes] " _
& "(Works_Number" & strOtherFieldsWC & ") " _
& "SELECT '" & rst!Works_Number & "' As
NewWorks_Number" _
& strOtherFieldsWC & " FROM tblWorksCard " _
& "WHERE Works_Number='" & rst!Works_Number & "';"

DBEngine(0)(0).Execute strsqlPack, dbFailOnError

'we have created the new entry now we should update the
notes
strOtherFields = ",Action_By,To_Do_date" _
& ",Project_Notes,Status"

strsql = "INSERT INTO [tblsubProjectNotes] " _
& "(Works_Number" & strOtherFields & ") " _
& "SELECT '" & rst!Works_Number & "' As
NewWorks_Number" _
& strOtherFields & " FROM tblProjectNotes_Input " _
& "WHERE Works_Number='" & rst!Works_Number & "';"

strsqlTick = "UPDATE [tblProjectNotes_Input]" & _
"SET tblProjectNotes_Input.Sent_Input = True
" & _
"WHERE Works_Number='" & rst!Works_Number &
"';"


DBEngine(0)(0).Execute strsql, dbFailOnError
'remember to check all of these records as having been
sent
DBEngine(0)(0).Execute strsqlTick, dbFailOnError
'Next - Done with this record move to the next record
visible

Else 'there is a match - the WCard number is in the Packing
List Table
'so append the note and goto the next record

strOtherFields = ",Action_By,To_Do_date" _
& ",Project_Notes,Status"

strsql = "INSERT INTO [tblsubProjectNotes] " _
& "(Works_Number" & strOtherFields & ") " _
& "SELECT '" & rst!Works_Number & "' As
NewWorks_Number" _
& strOtherFields & " FROM tblProjectNotes_Input " _
& "WHERE Works_Number='" & rst!Works_Number & "';"

strsqlTick = "UPDATE [tblProjectNotes_Input]" & _
"SET tblProjectNotes_Input.Sent_Input = True
" & _
"WHERE Works_Number='" & rst!Works_Number &
"';"


DBEngine(0)(0).Execute strsql, dbFailOnError
'remember to check all of these records as having been sent
DBEngine(0)(0).Execute strsqlTick, dbFailOnError
'Next - Done with this record move to the next record
visible


End If
rst1.Close 'clear the recorset for new start
rst.MoveNext 'move now to the next record in the recordset
Loop 'start the checking etc for this new record
Else 'there are no entries ie the recordset has no entries to append
'or we have reached the End of the set
'do nothing
End If

rst.Close

Forms!frmProjectNotes_Input.Requery
Me.Requery


Exit_CmdUpload_Button_Click:
Set rst = Nothing
Set rst1 = Nothing
Set db = Nothing
Exit Sub

Err_CmdUpload_Button_Click:
msgbox Err.Description
Resume Exit_CmdUpload_Button_Click


End Sub

Any help or guidance and advice really really apprecaited
Thanks
Regards
Click to expand...
 
Thanks dale,
I will follow your advice and see what transpires.
Thankyou.
Regards

Dale Fye said:
Bill,

My first thought is that rather than inserting the current record into
tblProjectNotes, you are inserting the current record and any like it.
Instead of the Insert/SELECT syntax you are using, why don't you try using
the Values method below.

My next thought is that although you mention "no matching parent" in your
problem description, it doesn't look like your are checking for the parent in
the line of code that does the FindFirst. In most of my tables that are
hierarchical, I have a Parent_ID field or something like that. Shouldn't you
be looking for that field?

Is Works_Number a string? Why would you give a field a name that implies it
is a number, and then make it a text datatype? If it is a string, then you
will need to wrap the references to rst!Works_Number in quotes.

I have a function I use that makes this easy:

Public Function Quotes(SomeText as Variant) as String
Quotes = chr$(34) & (SomeText & "") & chr$(34)
End Function

strtSQLPack = "INSERT INTO [tblProjectNotes] " _
& "(Works_Number" & strOtherFieldsWC & ") " _
& "VALUES (" & rst!Works_Number & ", " _
& Quotes(rst!Company_Name) & ")"

and then for the second one:

strsql = "INSERT INTO [tblsubProjectNotes] " _
& "(Works_Number" & strOtherFields & ") " _
& "Values (" & rst!Works_Number & ", " _
& quotes(rst!Action_By) & ", " _
& "#" & rst!To_Do_Date & "#, " _
& quotes(rst!Project_Notes) & ", " _
& rst!Status & ")"


----
HTH
Dale



Billp said:
Hi,

Trying and stretching my knowledge and skills to no avail at present.
The code loops but duplicates - so here is breifly a what is supposed to
happen.
I have a continuous form to which records are added.
Upon clicking a command button those records which visible are appended to
another table.
If the record showing has no matching parent in the other table a new parent
record is created and the record is appended.
If the parent record is in existance just append.
Continue doing thsi untill the visible records are finished.
With each record appended tick to say that it has been sent.
requery the form and because it has a base query set that the tick is false
no records will be shown.

Now here is the problem it loops nut also duplicates the records already in
existance on the other table - Here is what I have:

Private Sub CmdUpload_Button_Click()
On Error GoTo Err_CmdUpload_Button_Click
Me.Refresh
Dim strsql As String
Dim strsqlPack As String 'packingSlip table
Dim strsqlTick As String
Dim strOtherFields As String
Dim strOtherFieldsWC As String

Dim db As DAO.Database
Dim rst As DAO.Recordset 'first loop
Dim rst1 As DAO.Recordset

'*****************************************************************************
'find the first unchecked record - first loop
Set rst = Forms!frmProjectNotes_Input.RecordsetClone 'this is the visible
forms recorset
If rst.RecordCount > 0 Then 'there are some records showing
'remember that the form only shows records that are not checked
'as its based on a query.

Do While Not rst.EOF 'do until the end of the records showing
'for each record first check
'if there is a current Project Notes Form in existance
'and already associated with the visible records WCard Number
'if there is, update the note by appending it,
'if not create a new form associated with the WCard Number

Set db = CurrentDb
Set rst1 = db.OpenRecordset("tblProjectNotes", dbOpenDynaset)
rst1.FindFirst "Works_Number = """ & rst!Works_Number & """" 'check
the existing table

If rst1.NoMatch Then 'The return value is a Boolean that is True if
the desired record was not found.
'the Works Number number is not in the table
'therefore create a new notes entry for that
WCard number

strOtherFieldsWC = ",Company_Name"

strsqlPack = "INSERT INTO [tblProjectNotes] " _
& "(Works_Number" & strOtherFieldsWC & ") " _
& "SELECT '" & rst!Works_Number & "' As
NewWorks_Number" _
& strOtherFieldsWC & " FROM tblWorksCard " _
& "WHERE Works_Number='" & rst!Works_Number & "';"

DBEngine(0)(0).Execute strsqlPack, dbFailOnError

'we have created the new entry now we should update the
notes
strOtherFields = ",Action_By,To_Do_date" _
& ",Project_Notes,Status"

strsql = "INSERT INTO [tblsubProjectNotes] " _
& "(Works_Number" & strOtherFields & ") " _
& "SELECT '" & rst!Works_Number & "' As
NewWorks_Number" _
& strOtherFields & " FROM tblProjectNotes_Input " _
& "WHERE Works_Number='" & rst!Works_Number & "';"

strsqlTick = "UPDATE [tblProjectNotes_Input]" & _
"SET tblProjectNotes_Input.Sent_Input = True
" & _
"WHERE Works_Number='" & rst!Works_Number &
"';"


DBEngine(0)(0).Execute strsql, dbFailOnError
'remember to check all of these records as having been
sent
DBEngine(0)(0).Execute strsqlTick, dbFailOnError
'Next - Done with this record move to the next record
visible

Else 'there is a match - the WCard number is in the Packing
List Table
'so append the note and goto the next record

strOtherFields = ",Action_By,To_Do_date" _
& ",Project_Notes,Status"

strsql = "INSERT INTO [tblsubProjectNotes] " _
& "(Works_Number" & strOtherFields & ") " _
& "SELECT '" & rst!Works_Number & "' As
NewWorks_Number" _
& strOtherFields & " FROM tblProjectNotes_Input " _
& "WHERE Works_Number='" & rst!Works_Number & "';"

strsqlTick = "UPDATE [tblProjectNotes_Input]" & _
"SET tblProjectNotes_Input.Sent_Input = True
" & _
"WHERE Works_Number='" & rst!Works_Number &
"';"


DBEngine(0)(0).Execute strsql, dbFailOnError
'remember to check all of these records as having been sent
DBEngine(0)(0).Execute strsqlTick, dbFailOnError
'Next - Done with this record move to the next record
visible


End If
rst1.Close 'clear the recorset for new start
rst.MoveNext 'move now to the next record in the recordset
Loop 'start the checking etc for this new record
Else 'there are no entries ie the recordset has no entries to append
'or we have reached the End of the set
'do nothing
End If

rst.Close

Forms!frmProjectNotes_Input.Requery
Me.Requery


Exit_CmdUpload_Button_Click:
Set rst = Nothing
Set rst1 = Nothing
Set db = Nothing
Exit Sub

Err_CmdUpload_Button_Click:
msgbox Err.Description
Resume Exit_CmdUpload_Button_Click


End Sub

Any help or guidance and advice really really apprecaited
Thanks
Regards
Click to expand...
Click to expand...
 
Hi dale,

Thought I had better respond to your spot on questions.

Works_Number is actually a string - it takes the form >L00000
Alpha + 5 numbers

As it transpires the Works_Number the way it is constructed is unique.
There is however a unique ID field for each Works_Number in the table.
By luck or fate this has been set up.


Your first thought is correct I am inserting the current record and any
like it - that is the duplicating part which has caused the apoplexy.

Your second thought - didn't realise that is what must be happening.

Thank you for your valued observations and valued help.

Best regards

PS now to work and implemenataion of your thoughts.


Dale Fye said:
Bill,

My first thought is that rather than inserting the current record into
tblProjectNotes, you are inserting the current record and any like it.
Instead of the Insert/SELECT syntax you are using, why don't you try using
the Values method below.

My next thought is that although you mention "no matching parent" in your
problem description, it doesn't look like your are checking for the parent in
the line of code that does the FindFirst. In most of my tables that are
hierarchical, I have a Parent_ID field or something like that. Shouldn't you
be looking for that field?

Is Works_Number a string? Why would you give a field a name that implies it
is a number, and then make it a text datatype? If it is a string, then you
will need to wrap the references to rst!Works_Number in quotes.

I have a function I use that makes this easy:

Public Function Quotes(SomeText as Variant) as String
Quotes = chr$(34) & (SomeText & "") & chr$(34)
End Function

strtSQLPack = "INSERT INTO [tblProjectNotes] " _
& "(Works_Number" & strOtherFieldsWC & ") " _
& "VALUES (" & rst!Works_Number & ", " _
& Quotes(rst!Company_Name) & ")"

and then for the second one:

strsql = "INSERT INTO [tblsubProjectNotes] " _
& "(Works_Number" & strOtherFields & ") " _
& "Values (" & rst!Works_Number & ", " _
& quotes(rst!Action_By) & ", " _
& "#" & rst!To_Do_Date & "#, " _
& quotes(rst!Project_Notes) & ", " _
& rst!Status & ")"


----
HTH
Dale



Billp said:
Hi,

Trying and stretching my knowledge and skills to no avail at present.
The code loops but duplicates - so here is breifly a what is supposed to
happen.
I have a continuous form to which records are added.
Upon clicking a command button those records which visible are appended to
another table.
If the record showing has no matching parent in the other table a new parent
record is created and the record is appended.
If the parent record is in existance just append.
Continue doing thsi untill the visible records are finished.
With each record appended tick to say that it has been sent.
requery the form and because it has a base query set that the tick is false
no records will be shown.

Now here is the problem it loops nut also duplicates the records already in
existance on the other table - Here is what I have:

Private Sub CmdUpload_Button_Click()
On Error GoTo Err_CmdUpload_Button_Click
Me.Refresh
Dim strsql As String
Dim strsqlPack As String 'packingSlip table
Dim strsqlTick As String
Dim strOtherFields As String
Dim strOtherFieldsWC As String

Dim db As DAO.Database
Dim rst As DAO.Recordset 'first loop
Dim rst1 As DAO.Recordset

'*****************************************************************************
'find the first unchecked record - first loop
Set rst = Forms!frmProjectNotes_Input.RecordsetClone 'this is the visible
forms recorset
If rst.RecordCount > 0 Then 'there are some records showing
'remember that the form only shows records that are not checked
'as its based on a query.

Do While Not rst.EOF 'do until the end of the records showing
'for each record first check
'if there is a current Project Notes Form in existance
'and already associated with the visible records WCard Number
'if there is, update the note by appending it,
'if not create a new form associated with the WCard Number

Set db = CurrentDb
Set rst1 = db.OpenRecordset("tblProjectNotes", dbOpenDynaset)
rst1.FindFirst "Works_Number = """ & rst!Works_Number & """" 'check
the existing table

If rst1.NoMatch Then 'The return value is a Boolean that is True if
the desired record was not found.
'the Works Number number is not in the table
'therefore create a new notes entry for that
WCard number

strOtherFieldsWC = ",Company_Name"

strsqlPack = "INSERT INTO [tblProjectNotes] " _
& "(Works_Number" & strOtherFieldsWC & ") " _
& "SELECT '" & rst!Works_Number & "' As
NewWorks_Number" _
& strOtherFieldsWC & " FROM tblWorksCard " _
& "WHERE Works_Number='" & rst!Works_Number & "';"

DBEngine(0)(0).Execute strsqlPack, dbFailOnError

'we have created the new entry now we should update the
notes
strOtherFields = ",Action_By,To_Do_date" _
& ",Project_Notes,Status"

strsql = "INSERT INTO [tblsubProjectNotes] " _
& "(Works_Number" & strOtherFields & ") " _
& "SELECT '" & rst!Works_Number & "' As
NewWorks_Number" _
& strOtherFields & " FROM tblProjectNotes_Input " _
& "WHERE Works_Number='" & rst!Works_Number & "';"

strsqlTick = "UPDATE [tblProjectNotes_Input]" & _
"SET tblProjectNotes_Input.Sent_Input = True
" & _
"WHERE Works_Number='" & rst!Works_Number &
"';"


DBEngine(0)(0).Execute strsql, dbFailOnError
'remember to check all of these records as having been
sent
DBEngine(0)(0).Execute strsqlTick, dbFailOnError
'Next - Done with this record move to the next record
visible

Else 'there is a match - the WCard number is in the Packing
List Table
'so append the note and goto the next record

strOtherFields = ",Action_By,To_Do_date" _
& ",Project_Notes,Status"

strsql = "INSERT INTO [tblsubProjectNotes] " _
& "(Works_Number" & strOtherFields & ") " _
& "SELECT '" & rst!Works_Number & "' As
NewWorks_Number" _
& strOtherFields & " FROM tblProjectNotes_Input " _
& "WHERE Works_Number='" & rst!Works_Number & "';"

strsqlTick = "UPDATE [tblProjectNotes_Input]" & _
"SET tblProjectNotes_Input.Sent_Input = True
" & _
"WHERE Works_Number='" & rst!Works_Number &
"';"


DBEngine(0)(0).Execute strsql, dbFailOnError
'remember to check all of these records as having been sent
DBEngine(0)(0).Execute strsqlTick, dbFailOnError
'Next - Done with this record move to the next record
visible


End If
rst1.Close 'clear the recorset for new start
rst.MoveNext 'move now to the next record in the recordset
Loop 'start the checking etc for this new record
Else 'there are no entries ie the recordset has no entries to append
'or we have reached the End of the set
'do nothing
End If

rst.Close

Forms!frmProjectNotes_Input.Requery
Me.Requery


Exit_CmdUpload_Button_Click:
Set rst = Nothing
Set rst1 = Nothing
Set db = Nothing
Exit Sub

Err_CmdUpload_Button_Click:
msgbox Err.Description
Resume Exit_CmdUpload_Button_Click


End Sub

Any help or guidance and advice really really apprecaited
Thanks
Regards
Click to expand...
Click to expand...
 
Back
Top