[ACCESS VBA] Boucle avec OpenRecord

Bonjour,
je souhaite faire un boucle pour chercher une valeur de priorité. Par exemple sur je trouve la valeur 1 en priorité je passe a la recherche de la valeur 2.
Si je ne trouve pas la valeur 1, je cherche la valeur 2 et si je la trouve je la renomme en 1 et ainsi de suite sur toute les priorités.

Je ne comprends pas pourquoi la valeur 2 qui est trouvé quand la valeur 1 n'existe pas n'est pas écrasé :
La valeur 2 existe bien... GRRRR

Ci dessous mon code :

Sub Priorite()

...

Dim i As Integer
Dim j As Integer
Dim NBDEIPriorite As Integer
NBDEIPriorite = DCount("*", "RequêteDEIPrioriserEtape0")

Dim NomTable1 As String
Dim oRst1 As DAO.Recordset
Dim odb As DAO.Database
Dim Message As String
Set odb = CurrentDb
NomTable1 = "TB_DEI"
'Set oRst1 = odb.OpenRecordset(NomTable1)

Set db = CurrentDb()
Set oRst1 = odb.OpenRecordset("RequêteDEIPrioriserEtape0")
Set Base_Priorite = db.OpenRecordset("TB_DEI")

i = 1

'For i = 1 To NBDEIPriorite
While Not oRst1.EOF
If NatureTable = 2 Then Base_Priorite.FindFirst ("NumPriorite=" & i & "")
If NatureTable = 1 Then Base_Priorite.Index = "NumPriorite"
If NatureTable = 1 Then Base_Priorite.Seek "=", i

If Base_Priorite.NoMatch = True And NatureTable = 2 Then Base_Priorite.FindFirst ("NumPriorite=" & i + 1 & "")
If Base_Priorite.NoMatch = True And NatureTable = 1 Then Base_Priorite.Index = "NumPriorite"
If Base_Priorite.NoMatch = True And NatureTable = 1 Then Base_Priorite.Seek "=", i + 1

If Base_Priorite.NoMatch = False Then Base_Priorite.Edit
If Base_Priorite.NoMatch = False Then Base_Priorite("NumPriorite") = i

i = i + 1
If i = 3 Then Exit Sub

oRst1.MoveNext
Wend

End Sub
Configuration: Windows XP
Internet Explorer 6.0

7 réponses

  1. Modérateur
    Salut,
    If Base_Priorite.NoMatch = False Then Base_Priorite.Edit 
    C'est supposé faire quoi ?
    1. ET bien en fait quand une priorité existe par exemple priorité 2, alors je lance l'ouverture en EDIT pour modifier la valeur 2 soit (i+1) en i soit i.

      Base_Priorite.NoMatch = False donc non vide ce qui signifie que la valeur existe.

      MAis je ne comprends pas pourquoi cela ne fonctionne pas ?
      1. merci de la reponse, helas le probleme ne vient pas de l update.

        peut etre que c est lie au fait que je fais des requetes sur un extrait de table issu d une requete
        je vais faire des tests en SQL directement pour voir ce week end.

        merci en tout cas.
        1. salut, il me reste un dernier problème a résoudre, c'est que je sature les ouverture de bases de données, j'ai un message d'erreur,
          Erreur d'execution 3048 : impossible d'ouvrir plus de bases de données, par contre je ne vois pas ou les clôture et a quel moment ?

          Sub Priorite2()
          Set db = CurrentDb()

          Dim i As Integer
          Dim j As Integer
          Dim NBDEIPriorite As Integer
          Dim NumeroTempoPriorite As Integer
          NBDEIPriorite = DCount("*", "RequêteDEIPrioriserEtape0")

          Dim NomTable1 As String
          Dim oRst1 As DAO.Recordset
          Dim odb As DAO.Database
          Dim Message As String
          Set odb = CurrentDb
          NomTable1 = "TB_DEI"
          Set oRst1 = odb.OpenRecordset(NomTable1)

          i = 1
          Do
          Set db = CurrentDb()

          'While Not oRst1.EOF
          Dim strSQLJ1 As String
          strSQLJ1 = "SELECT TB_DEI.NumDEI, TB_DEI.NumProjet, TB_DEI.EtatDEI, TB_DEI.NumPriorite FROM TB_DEI WHERE (((TB_DEI.NumDEI) Is Not Null) AND ((TB_DEI.NumProjet) Is Not Null) AND ((TB_DEI.EtatDEI)<>" & Chr(34) & "Terminée" & Chr(34) & " Or (TB_DEI.EtatDEI) = " & Chr(34) & "Abandonnée" & Chr(34) & " Or (TB_DEI.EtatDEI) = " & Chr(34) & "Refusée" & Chr(34) & ") AND TB_DEI.NumPriorite= " & i & ");"

          CurrentDb.QueryDefs("Requete_Priorite_tempo").SQL = strSQLJ1
          NomRequete = "Requete_Priorite_tempo"

          NumeroTempoPriorite = DCount("*", "Requete_Priorite_tempo")

          j = i

          If NumeroTempoPriorite = 0 Then Call Remplacement0(i, j)
          If NumeroTempoPriorite = 1 Then Call Remplacement1(i, j)
          If NumeroTempoPriorite > 0 Then Call Remplacement2(i, j)

          i = i + 1
          If i = 5 Then Exit Sub
          Loop
          End Sub

          Sub Remplacement0(i, j)
          Set db = CurrentDb()

          Dim NatureT As Integer
          Dim NatureTable As Integer
          NatureT = DCount("*", "NatureTableRequete")
          If NatureT = 1 Then NatureTable = 1
          If NatureT <> 1 Then NatureTable = 2
          Set Base_priorite = db.OpenRecordset("Requete_Priorite_tempo")

          Dim strSQLJ1 As String

          strSQLJ1 = "SELECT TB_DEI.NumDEI, TB_DEI.NumProjet, TB_DEI.EtatDEI, TB_DEI.NumPriorite FROM TB_DEI WHERE (((TB_DEI.NumDEI) Is Not Null) AND ((TB_DEI.NumProjet) Is Not Null) AND ((TB_DEI.EtatDEI)<>" & Chr(34) & "Terminée" & Chr(34) & " Or (TB_DEI.EtatDEI) = " & Chr(34) & "Abandonnée" & Chr(34) & " Or (TB_DEI.EtatDEI) = " & Chr(34) & "Refusée" & Chr(34) & ") AND TB_DEI.NumPriorite= " & j + 1 & ");"

          Set odb = CurrentDb
          CurrentDb.QueryDefs("Requete_Priorite_tempo").SQL = strSQLJ1
          NomRequete = "Requete_Priorite_tempo"
          Set orst2 = odb.OpenRecordset(NomRequete)

          If orst2.NoMatch = True Then NumeroTempoPriorite = 0
          If orst2.NoMatch = False Then NumeroTempoPriorite = DCount("*", "Requete_Priorite_tempo")
          'MsgBox (NumeroTempoPriorite)
          CurrentDb.QueryDefs("Requete_Priorite_tempo").Close
          If NumeroTempoPriorite = 0 Then j = j + 1
          If NumeroTempoPriorite = 0 Then Call Remplacement0(i, j)

          If NumeroTempoPriorite = 1 Then Set Base_priorite = db.OpenRecordset("Requete_Priorite_tempo")
          If NumeroTempoPriorite = 1 And NatureTable = 2 Then Base_priorite.FindFirst ("NumPriorite=" & j + 1 & "")
          If NumeroTempoPriorite = 1 And NatureTable = 1 Then Base_priorite.Index = "NumPriorite"
          If NumeroTempoPriorite = 1 And NatureTable = 1 Then Base_priorite.Seek "=", i
          If NumeroTempoPriorite = 1 And Base_priorite.NoMatch = True Then Exit Sub
          If NumeroTempoPriorite = 1 And Base_priorite.NoMatch = False Then Base_priorite.Edit
          If NumeroTempoPriorite = 1 And Base_priorite.NoMatch = False Then Base_priorite("NumPriorite") = i
          If NumeroTempoPriorite = 1 And Base_priorite.NoMatch = False Then Base_priorite.Update

          If NumeroTempoPriorite > 0 Then Call Remplacement2(i, j)
          'db.Close
          End Sub

          Sub Remplacement1(i, j)
          End Sub

          Sub Remplacement2(i, j)
          End Sub
          1. bonjour,
            le problème de l'alerte : Erreur d'execution 3048 est résolvable par : On Error Resume Next

            mais hélas nous atteignons les limites d'access.
            malgré les .close des recordsets.
            1. Modérateur
              Les limites d'access sont plus importantes que ça (pour l'avoir un peu trituré).

              Je pense que ton code n'est pas très optimisé : tu déclares plusieurs variables en type database, avec le même contenu (currentdb) et certaines fois, tu ne t'en sers pas.

              Pour libérer une variable, le .close ne suffit pas, il faut rendre l'espace mémoire avec set variable = null.
          2. ok; merci pour l'info, je vais vider la mémoire.
            Bonne soirée.