Very basic loop problem

[mehmeh via AccessMonster.com]

Hi,


I’m having a little problem with my loop.

My aim is for it to keep the first record, delete the next 19, keep the next
record, delete the next 19 etc, until there are no more records (there are
500).

I’ve been given a table with a very dodgy layout so I’m just trying to
extract the data.

This is what I’ve got so far although, as you can tell, it has failed
miserably:


Private Sub Command2_Click()
On Error GoTo Err_Command2_Click

Dim Time As Long
Time = 1

Do While Time < 501

‘Select next record
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")
DoCmd.DeleteObject ("DELETE * FROM Table1 WHERE [ID] = Time")

Time = Time + 1

Loop


Exit_Command2_Click:
Exit Sub

Err_Command2_Click:
MsgBox Err.Description
Resume Exit_Command2_Click

End Sub

I need to rewrite the ‘select next record’ bit as I just deleted it by
accident.

 

[mehmeh via AccessMonster.com]

A little closer:

Private Sub Command2_Click()
On Error GoTo Err_Command2_Click

Dim tdm As Integer
tdm = 1

DoCmd.SetWarnings False

Do While tdm < 20


DoCmd.GoToRecord , , acNext 'go to next record

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70
'etc 19times

tdm = tdm + 1

Loop

DoCmd.SetWarnings True


Exit_Command2_Click:
Exit Sub

Err_Command2_Click:
MsgBox Err.Description
Resume Exit_Command2_Click

End Sub


It just tells me it cannot go to the next record now??

 

[Stefan Hoffmann]

hi,

i would use another approach:

use a second table, same layout, no data:

Dim rs As DAO.Recordset

Set rs = CurrentDb.OpenRecordset("YourTable")
Do While Not rs.Eof
'code to copy record in second table
rs.MoveBy 19
Loop



mfG
--> stefan <--

 

[mehmeh via AccessMonster.com]

Woo cheers, I started trying it your way (which makes mroe sense) although
had trouble with getting it to copy the data across (newbie) so I improvised
and combined the two codes:



Private Sub Command2_Click()
On Error GoTo Err_Command2_Click

Dim rs As DAO.Recordset


DoCmd.SetWarnings False

Set rs = CurrentDb.OpenRecordset("Table1")
Do While Not rs.EOF
'code to copy record in second table
DoCmd.GoToRecord , , acNext 'go to next record

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70


DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
DoCmd.DoMenuItem acFormBar, acEditMenu, 7, , acMenuVer70

Loop

DoCmd.SetWarnings True


Exit_Command2_Click:
Exit Sub

Err_Command2_Click:
MsgBox Err.Description
Resume Exit_Command2_Click

End Sub


It is sloooooowww butI only need to run it a couple of times to extract the
data so all is good .

Thanks; much much appreciated.

 

[Albert D. Kallal]

When you do processing on a table, you don't actually use the form to move
to the next/previous record.

You can create a UN-BOUND form. (this form is NOT attached to the table).
You then
use ONLY code to update the data.

here how we can delete some rocords..and then keep the next one:

Place the following code behind command button on this new un-bound form.

Private Sub Command18_Click()

Dim rstData As DAO.Recordset
Dim i As Integer

Set rstData = CurrentDb.OpenRecordset("tblData")
Do While rstData.EOF = False
i = i + 1
If i = 20 Then
i = 0
Else
rstData.Delete
End If
rstData.MoveNext
Loop
rstData.Close


End Sub