Need help filling a table

[Lady85]

Hi,

I want to fill a table with some data, however it is not working as I'd like. This is my code:

Private Sub Command30_Click()
Dim rstVondstNummers As ADODB.Recordset 'wordt gebruikt om met de vondstnummer records te werken
Dim lngBeginBereik As Long 'onthoudt wat het begin van het bereik aan vondstnummers is
Dim lngEindeBereik As Long 'onthoudt wat het einde van het bereik aan vondstnummers is
Dim lngExchange As Long 'wordt gebruikt om lngBeginBereik en lngEindeBereik om te wisselen
Dim strWhere As String 'bepaalt uiteindelijk de condities voor welke labels worden geprint
Dim lngBeginZeefvak As Long 'onthoudt wat het begin van het bereik aan zeefvakken is
Dim lngEindeZeefvak As Long 'onthoudt wat het einde van het bereik aan zeefvakken is
Dim lngBeginLaag As Long 'onthoudt wat het begin van het bereik aan lagen is
Dim lngEindeLaag As Long 'onthoudt wat het einde van het bereik aan lagen is
Dim I As Integer 'iterator
On Error Resume Next
'Haal de tabel met vondstnummers op
Set rstVondstNummers = New ADODB.Recordset
rstVondstNummers.LockType = adLockOptimistic
rstVondstNummers.Open "vondstbijhouden", CurrentProject.Connection, adOpenKeyset
'Stel het bereik van de te printen lagen in
lngBeginLaag = 1
lngEindeLaag = 3
'Stel het bereik van de te printen zeefvakken in
lngBeginZeefvak = 1
lngEindeZeefvak = 1080
'Stel het bereik van de te printen vondstnummers in
lngBeginBereik = 1
lngEindeBereik = 3
'Voeg nu alle ontbrekende records toe
For I = lngBeginBereik To lngEindeBereik Step 1
  rstVondstNummers.MoveFirst 'begin met zoeken bij het eerste record in de set
  rstVondstNummers.Find "vondstnummer=" & CStr(I), 0, adSearchForward 'zoek het record met het opgegeven vondstnummer
  If rstVondstNummers.EOF Then 'als niet EOF, dan bestaat het record
    For L = lngBeginLaag To lngEindeLaag Step 1
      For Z = lngBeginZeefvak To lngEindeZeefvak Step 1
        rstVondstNummers.AddNew
        rstVondstNummers!vondstnummer = I
        rstVondstNummers!Zeefvak = Z
        rstVondstNummers!Laagnummer = L
        rstVondstNummers.Update
        Next Z
    Next L
  End If
Next I
'Sluit de tabel weer netjes
rstVondstNummers.Close
'Bepaal de condities voor welke labels moeten worden geprint
strWhere = "vondstnummer BETWEEN " & CStr(lngBeginBereik) & " AND " & CStr(lngEindeBereik)
'Print de label reeks
DoCmd.OpenReport "Labelreeks2", acViewNormal, , strWhere
'DoCmd.OpenReport "LabelReeks", acViewPreview, , strWhere
MsgBox "De labels worden geprint.", vbInformation + vbOKOnly, "Bezig met printen"
End Sub

It needs to fill the table for each record with a Vondstnummer that is unique and needs to increase by 1.
It also needs to insert the value Zeefvak, that starts with 1 and increases as well.
It also needs to insert the value Laag, which needs to number from 1 to 3 for each zeefvak.
So each record would need to look like this:

vondstnummer 1, zeefvak 1, laagnummer 1
vondstnummer 2 zeefvak 1, laagnummer 2
vondstnummer 3, zeefvak 1, laagnummer 3
vondstnummer 4, zeefvak 2, laagnummer 1
vondstnummer 5, zeefvak 2, laagnummer 2

However right now it fills it in like this:

vondstnummer 1, zeefvak 1, laagnummer 1
vondstnummer 1, zeefvak 2, laagnummer 1
vondstnummer 1, zeefvak 3, laagnummer 1

and so on until zeefvak 1080, then it continues with vondstnummer 1, zeefvak 1, laagnummer 2, until zeefvak reaches 1080 again, and so on. So it creates 9720 records instead of 3.

and so on, can anyone point me to what I'm doing wrong and help me in the right direction?

Thanks!

 

[arnelgp]

if you like use Dao, its much simpler to use:

Private Sub Command30_Click()
Dim rstVondstNummers As Dao.Recordset 'wordt gebruikt om met de vondstnummer records te werken
Dim lngBeginBereik As Long 'onthoudt wat het begin van het bereik aan vondstnummers is
Dim lngEindeBereik As Long 'onthoudt wat het einde van het bereik aan vondstnummers is
Dim lngExchange As Long 'wordt gebruikt om lngBeginBereik en lngEindeBereik om te wisselen
Dim strWhere As String 'bepaalt uiteindelijk de condities voor welke labels worden geprint
Dim lngBeginZeefvak As Long 'onthoudt wat het begin van het bereik aan zeefvakken is
Dim lngEindeZeefvak As Long 'onthoudt wat het einde van het bereik aan zeefvakken is
Dim lngBeginLaag As Long 'onthoudt wat het begin van het bereik aan lagen is
Dim lngEindeLaag As Long 'onthoudt wat het einde van het bereik aan lagen is
Dim I As Integer 'iterator
Dim db As Dao.Database
On Error Resume Next

DBEngine.SetOption dbMaxLocksPerFile, 20000
set db = currentdb
set rstVondstNummers = db.OpenRecordset("vondstbijhouden", dbOpenDynaset)
'Haal de tabel met vondstnummers op
'Set rstVondstNummers = New ADODB.Recordset
'rstVondstNummers.LockType = adLockOptimistic
'rstVondstNummers.Open "vondstbijhouden", CurrentProject.Connection, adOpenKeyset
'Stel het bereik van de te printen lagen in
lngBeginLaag = 1
lngEindeLaag = 3
'Stel het bereik van de te printen zeefvakken in
lngBeginZeefvak = 1
lngEindeZeefvak = 1080
'Stel het bereik van de te printen vondstnummers in
lngBeginBereik = 1
lngEindeBereik = 3

'Voeg nu alle ontbrekende records toe
For I = lngBeginBereik To lngEindeBereik Step 1
  rstVondstNummers.MoveFirst 'begin met zoeken bij het eerste record in de set
  'rstVondstNummers.Find "vondstnummer=" & CStr(I)  , 0, adSearchForward 'zoek het record met het opgegeven vondstnummer
  rstVondstNummers.FindFirst "vondstnummer=" & I   ', 0, adSearchForward 'zoek het record met het opgegeven vondstnummer
  'If rstVondstNummers.EOF Then 'als niet EOF, dan bestaat het record
  If rstVondstNummers.NoMatch Then 'als niet EOF, dan bestaat het record
    For L = lngBeginLaag To lngEindeLaag Step 1
      For Z = lngBeginZeefvak To lngEindeZeefvak Step 1
        rstVondstNummers.AddNew
        rstVondstNummers!vondstnummer = I
        rstVondstNummers!Zeefvak = Z
        rstVondstNummers!Laagnummer = L
        rstVondstNummers.Update
    DoEvents
        Next Z
    DBEngine.Idle dbRefreshCache
    Next L
  End If
Next I
'Sluit de tabel weer netjes
rstVondstNummers.Close
set rstVondstNummers = Nothing
set db=Nothing
'Bepaal de condities voor welke labels moeten worden geprint
strWhere = "vondstnummer BETWEEN " & CStr(lngBeginBereik) & " AND " & CStr(lngEindeBereik)
'Print de label reeks
DoCmd.OpenReport "Labelreeks2", acViewNormal, , strWhere
'DoCmd.OpenReport "LabelReeks", acViewPreview, , strWhere
MsgBox "De labels worden geprint.", vbInformation + vbOKOnly, "Bezig met printen"
End Sub

 

[Lady85]

Unfortunately this code does exactly the same thing my code does.....

 

[arnelgp]

modify this part with:

'Voeg nu alle ontbrekende records toe
For I = lngBeginBereik To lngEindeBereik Step 1
  rstVondstNummers.MoveFirst 'begin met zoeken bij het eerste record in de set
  'rstVondstNummers.Find "vondstnummer=" & CStr(I)  , 0, adSearchForward 'zoek het record met het opgegeven vondstnummer
  rstVondstNummers.FindFirst "vondstnummer=" & I   ', 0, adSearchForward 'zoek het record met het opgegeven vondstnummer
  'If rstVondstNummers.EOF Then 'als niet EOF, dan bestaat het record
  If rstVondstNummers.NoMatch Then 'als niet EOF, dan bestaat het record
    For L = lngBeginLaag To lngEindeLaag Step 1
      For Z = lngBeginZeefvak To lngEindeZeefvak Step 1
    db.execute "insert into vondstbijhouden (vondstnummer, Zeefvak, Laagnummer) " & _
            "SELECT " & I & ", " & Z & ", " & L & ";"
    DoEvents
        Next Z
    DBEngine.Idle dbRefreshCache
    Next L
  End If
Next I