Erreur Module pour empecher le Shift (SetBypassProperty) [Résolu]

[lars528]

Bonjour à tous,

je voudrais réliser un petit programme access pour pouvoir bloquer et débloquer l'appuie sur la touche Shift de n'importe quelle DB.

J'ai pris exemple sur le code fourni par l'aide office. Mais un problème se pose :

-Quand j'essaie de bloquer ou débloquer en lançant la fonction, il y a un plantage : erreur 3259, Invalif Field DataType.

Voici le code de mon module :

Code :

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
Option Compare Database
 
Sub SetBypassProperty(Asecuriser As Boolean)
Const DB_Boolean As Boolean = 1
ChangeProperty "AllowBypassKey", DB_Boolean, Asecuriser '3eme argument : false : securiser
End Sub
 
Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
On Error GoTo ErreurChangeProperty
 
Dim MaBD    As Database
Set MaBD = DBEngine.Workspaces(0).Databases(0)
 
Dim dbs As Object, prp As Variant
Const conPropNotFoundError = 3270
Dim maBaseDeDonnees As String
 
Dim TabIn   As Recordset
Set TabIn = MaBD.OpenRecordset("Tab_CheminDB", DB_OPEN_TABLE)
TabIn.MoveLast
On Error GoTo 0
    TabIn.MoveFirst
    Do Until TabIn.EOF
        TabIn.Edit
        maBaseDeDonnees = TabIn("CheminDB")
        TabIn.MoveNext
    Loop
 
 
Set dbs = OpenDatabase(maBaseDeDonnees)
 
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
MsgBox "Opération effectué avec succes..."
 
ex:
Exit Function
 
ErreurChangeProperty:
    Msg = "Erreur : " & Error(Err.Number)
    Msg = Msg & Chr(13) & Chr(13) & "Il n'y a aucun record dans la table Tab_CheminDB."
    MsgBox Msg, 0, "Attention"
    Err.Clear
Exit Function
 
 
Change_Bye:
Exit Function
 
Change_Err:
   If Err = conPropNotFoundError Then ' Propriété non trouvée.
       Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue)
        dbs.Properties.Append prp
        Resume Next
   Else
      ' Erreur inconnue.
      ChangeProperty = False
      Resume Change_Bye
   End If
End Function

Auriez-vous une idée de l'origine du problème ?

Merci d'avance.

[Dolphy35]

Salut,

Ton code est bien long je trouve, je l'ai juste survolé mais la dispose d'un code qui fonctionne à tous les coups :

j'en ai déjà discutté ici :

http://www.developpez.net/forums/sho...d.php?t=262423

Dolphy

[lars528]

Bonjour,

En comparant ton code au mien, j'ai remarqué quelques différences. Que j'ai corrigées. Et ca marche !
Mon code est plus long car je stocke les chemins vers les DB dans une table pour pouvoir verrouiller plusieurs DB en même temps.

En tout cas, merci !

a+