Recherche dans plusieurs bases dans un même répertoire

**nemog** · 30/05/2022, 14h49

Bonjour

Désolé si le sujet a déjà été traité, je suis peut-être passé à coté

J'ai plusieurs bases dans un répertoire (même structure) .
Quand je ne trouve pas ce que je veux dans la 1ere, je voudrais qu' Access cherche (exécute la requête) dans les autres.
Est-ce possible si le nom des bases et leur nombre ne sont pas prédéfinis ? (*.accdb dans le dossier \xxxxx\yyyy\ )
J'avais un code, à une époque, qui me permettait de chercher dans une autre base bien précise, mais là, j'ai besoin de plus de "souplesse".

Merci si vous pouvez m'aider,

Cordialement,

Nemog

**hyperion13** · 30/05/2022, 16h51

Salut
Un début de piste ici

**nemog** · 30/05/2022, 19h04

@hyperion13

Merci, c'est effectivement un bon début, je vais voir si je peux m'en sortir avec ça

**nemog** · 31/05/2022, 11h19

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Private Sub RechGlob_AfterUpdate()
 
 
DoCmd.OpenForm "formgen", , , "affectation like forms.formAccueil.rechglob"
 
    If IsNull(Forms.formgen.Affectation) Then    
        DoCmd.Close        
    End If
 
        Dim autreBdd As Access.Application    
        Set autreBdd = CreateObject("Access.Application")
 
 
    Const StrFolder = "C:\REPPBX_Base\"
    Dim StrFile, StrComplet, StrRechGlob As String
 
    StrFile = Dir(StrFolder & "*.*")
 
   Do While StrFile <> ""
 
 
        If Left$("StrFile", 3) = "PN_" Then
        GoTo suite
        End If
 
 
   If LCase(StrFile) Like "*.mdb" Or LCase(StrFile) Like "*.accdb" Then
 
 
       StrComplet = StrFolder & StrFile
       StrRechGlob = Forms.FormAccueil.RechGlob
 
 
		With autreBdd
 
			.OpenCurrentDatabase StrComplet
			.Visible = True
			.UserControl = True
			.DoCmd.OpenForm "FormGen", , , "affectation like StrRechGlob", , acWindowNormal
 
 
		End With
 
  End If
 
suite:
 
  Loop    
 
 
End Sub

Bon j'ai pris des éléments à droite et à gauche et dans la suggestion de Hyperion13, et "pondu" cela.

Ca ne marche pas :
La nouvelle base ouverte me demande la valeur de StrRechGlob avant d'ouvrir le formulaire FormGen qui est lié à une table TabGen comprenant, entre autres, le champ "Affectation"
Et la boucle ne passe pas à la base suivante mais essaie de rouvrir la 1ere ( ça s' arrête là puisque ça génère un message d' erreur "base déjà ouverte" )

RechGlob est le textbox à remplir dans le formulaire FormAccueil de la 1ere base, dont le nom commence par "PN_" et que, bien sûr, on ne veut pas rouvrir

J'espère être à peu près clair

Où me trompe-je ?

**nemog** · 01/06/2022, 14h22

J'ai un peu progressé mais il y a encore du boulot !

Je ne comprends pas bien comment fonctionne la prise en compte des fichiers dans le répertoire : DIR....
Avec ce code, ça commence avec le 2e fichier dans l'ordre alphabetique

Et je voudrais qu' après le 1er SQL, si la réponse est "vide", càd n'a pas trouvé de correspondance, la base concernée ne s'ouvre pas
mais je n'arrive pas à écrire cette condition (voir ligne 71)

Désolé, plus j'essaie des choses et plus je m' embrouille !

Heeeeelp !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Private Sub RechGlob_AfterUpdate()
 
 
' Recherche dans la base ouverte
 
DoCmd.OpenForm "formgen", , , "affectation like forms.formAccueil.rechglob"
 
    If IsNull(Forms.formgen.Affectation) Then
 
        DoCmd.Close
 
        Else
 
        Exit Sub
 
    End If
 
 
' Recherche dans les autres bases
 
 
    Dim autreBdd As Access.Application
    Set autreBdd = CreateObject("Access.Application")
 
 
    Const StrFolder = "C:\REPPBX_Base\"
    Dim StrFile, StrComplet, StrRechGlob, monsql, monsql2 As String
    Dim rst As DAO.Recordset
    Dim v As Variant
    Dim i As Integer
    i = 0
 
 
 
    StrFile = Dir(StrFolder & "*.*")
 
    Do While StrFile <> ""
 
 
 
        StrFile = Dir
        'i = i + 1
 
 
            MsgBox "fichier = " & StrFile
            If Left$(StrFile, 3) = "PN_" Then
                GoTo suite
            End If
 
 
        'MsgBox "Folder = " & StrFolder
        'MsgBox "fichier = " & StrFile
 
         If LCase(StrFile) Like "*.mdb" Or LCase(StrFile) Like "*.accdb" Then
 
 
            StrComplet = StrFolder & StrFile
            StrRechGlob = Forms.formAccueil.RechGlob
 
 
            'MsgBox "chemin complet = " & StrComplet
            'MsgBox "RechGlob = " & Forms.formAccueil.RechGlob
            'MsgBox "StrRechGlob = " & StrRechGlob
 
 
 
              monsql2 = "SELECT TabGen.Affectation FROM TabGen IN " & "'" & StrComplet & "'" & " WHERE TabGen.Affectation like " & "'" & StrRechGlob & "'"
				Set rst = CurrentDb.OpenRecordset(monsql2, dbOpenDynaset)
				v = rst.Fields("affectation")
 
                'If DCount("affectation", (monsql2)) = 1 Then
		If v = StrRechGlob then	
 
                 With autreBdd
 
                    .Visible = False
                    .OpenCurrentDatabase StrComplet
 
                 End With
 
 
                    monsql = "UPDATE TabTempGlob IN " & "'" & StrComplet & "'" & "  SET TabTempGlob.Affectation = " & "'" & StrRechGlob & "'"
                    DoCmd.RunSQL monsql
 
                With autreBdd
 
                    .DoCmd.OpenForm "FormTempGlob", , , , , acHidden
                    .Visible = True
                    .DoCmd.OpenForm "FormGen", , , "affectation like forms.FormTempGlob.affectation", , acWindowNormal
 
 
                End With
 
                'If IsNull(autreBdd.Forms!formgen!Affectation) Then                   
				   'autreBdd.DoCmd.CloseDatabase  
 
                'End If
 
 
           End If
 
        End If
 
suite:
 
         If i > 3 Then
            Exit Sub
         End If
 
  Loop
 
End Sub

Ce code marche si le SQL monsql2 trouve la valeur demandée
S'il ne la trouve pas, j'ai msg d'erreur "3021" Aucun enregistrement en cours sur la ligne 69 - v = rst.Fields(....)

**hyperion13** · 02/06/2022, 20h05

re,
Après L68, peut-être insérer If rst.RecordCount = 0 Then Exit Sub ou autre formulation ?
Que contient StrRechGlob?

**nemog** · 03/06/2022, 14h03

Merci Hyperion13, c'est exactement ce qu'il me fallait !

Maintenant, ça marche mais j'ai encore un petit souci :
Si la valeur que je cherche (strRechGlob) se trouve dans plus d'une base, à la tentative d'ouverture de la suivante, ça échoue
J'ai le message "base déjà ouverte" alors que c'est en fait une autre - à la ligne 62
En plus c'est casse-bonbons parce qu'il faut arrêter Access par le gestionnaire de tâches et effacer manuellement le .laacdb de la base qui ne s'est soi-disant pas ouverte !
Peut-on palier à ça ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Private Sub RechGlob_AfterUpdate()
 
 
' Recherche dans la base ouverte
 
DoCmd.OpenForm "FormGen", , , "affectation like Forms.FormAccueil.rechglob"
 
    If IsNull(Forms.FormGen.Affectation) Then
 
        DoCmd.Close
 
        Else
 
        Exit Sub
 
    End If
 
 
' Recherche dans les autres bases
 
 
    Dim autreBdd As Access.Application
    Set autreBdd = CreateObject("Access.Application")
 
 
    Const StrFolder = "C:\REPPBX_Base\"
    Dim StrFile, StrComplet, StrRechGlob, monsql, monsql2 As String
    Dim rst As Recordset
 
 
    StrFile = Dir(StrFolder & "*.*")
 
    Do While StrFile <> ""
 
 
            If Left$(StrFile, 3) = "PN_" Then
                GoTo suite
            End If
 
 
         If LCase(StrFile) Like "*.mdb" Or LCase(StrFile) Like "*.accdb" Then
 
 
            StrComplet = StrFolder & StrFile
            StrRechGlob = Forms.FormAccueil.RechGlob
 
 
             monsql2 = "SELECT TabGen.Affectation FROM TabGen IN " & "'" & StrComplet & "'" & " WHERE TabGen.Affectation like " & "'" & StrRechGlob & "'"
 
             Set rst = CurrentDb.OpenRecordset(monsql2, dbOpenDynaset)
 
              If rst.RecordCount = 0 Then
 
                GoTo suite
 
              End If
 
 
                 With autreBdd
 
                    .Visible = False
                    .OpenCurrentDatabase StrComplet
 
 
                 End With
 
 
                    monsql = "UPDATE TabTempGlob IN " & "'" & StrComplet & "'" & "  SET TabTempGlob.Affectation = " & "'" & StrRechGlob & "'"
                    DoCmd.RunSQL monsql
 
                With autreBdd
 
                    .DoCmd.OpenForm "FormTempGlob", , , , , acHidden
                    .Visible = True
                    .DoCmd.OpenForm "FormGen", , , "affectation like forms.FormTempGlob.affectation", , acWindowNormal
 
 
                End With
 
 
           End If
 
suite:
 
         StrFile = Dir
 
  Loop
 
 
End Sub

**hyperion13** · 03/06/2022, 15h14

re,
Que contient StrRechGlobob (Forms.FormAccueil.rechglob) comme valeur ?
Pour "killer" un process

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim strKill As String
strKill = "TASKKILL /F /IM MSACCESS.exe"
Shell strKill, vbHide

**nemog** · 03/06/2022, 15h44

Quel killer !

StrRechGlob est un nombre à 6 chiffres

**hyperion13** · 04/06/2022, 06h57

Et à quoi correspond ce nombre ? Un objet (tbl, qry, frm, rpt, bas) de la bdd ?

**nemog** · 04/06/2022, 07h30

euuuuh comprends pas la question

Ce nombre à 6 chiffres (n° de téléphone privé) est la valeur que rentre l'utilisateur dans le champ FormAccueil!Rechglob pour faire la recherche sur toutes les bases présentes dans le répertoire

Alors mon code est sûrement atypique et pourquoi une chaine de caractère pour un nombre ? je suppose que c'est ce qui te tracasse ? pitêtre ?

**hyperion13** · 04/06/2022, 07h47

re,
dans votre Post#1 vous ne précisiez pas l'objet de votre recherche.
je pensais que vous cherchiez dans d'autres bdd, des objets tels que tbl, qry, frm, rpt, etc.
là à priori il est question de chercher une donnée dans d'autres bdd.

**nemog** · 04/06/2022, 08h00

Tout à fait !
Désolé de ne pas avoir été plus clair

Tout marche maintenant, avec toujours ce petit bémol de la "base déjà ouverte" quand la même valeur se trouve dans plus d'une base

Recherche dans plusieurs bases dans un même répertoire

VBA Access

Discussions similaires

Partager

Partager