[ACCESS VBA] Boucle avec OpenRecord

artamys -  
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

  • Votes
  • Date
  • Date décroissante
  1. artamys Auteur
    ok; merci pour l'info, je vais vider la mémoire.
    Bonne soirée.
    1. artamys Auteur
      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. blux 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. artamys Auteur
      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. artamys Auteur
        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.
        3. artamys Auteur
          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. blux Modérateur
            Salut,
            If Base_Priorite.NoMatch = False Then Base_Priorite.Edit
            C'est supposé faire quoi ?

            Discussions similaires

            Avast HNS-SELF-WAN-ACCESS-IPV6
            Astafor99

            5 réponses
            Quick Access service
            alain_1949

            4 réponses
            Acer quick access
            Bidou21

            2 réponses
            Mon pc s'allume et s'éteint en boucle
            Jack

            16 réponses
            Access 2016
            natha_9597

            1 réponse