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
| Sub ChgODBClink_DAO2()
Dim strConn As String, db As DAO.Database, td As DAO.TableDef
Dim strParts() As String, i As Integer
Dim strTable As String, strUID As String, strPWD As String
Dim errX As DAO.Error, strErrMsg As String
Dim strCreateIdx As String, strUniqueRecord As String
strTable = "mysql_fournisseurs2"
strUniqueRecord = "[N° fournisseur] ASC"
strUID = "NvUtilisateur"
strPWD = "NvMotDePasse"
Set db = CurrentDb
On Error Resume Next
Set td = db.TableDefs(strTable)
On Error GoTo 0
If td Is Nothing Then
strErrMsg = "La Table '" & strTable & "' est introuvable"
GoTo QUIT
End If
' Si la table est bien une table liée ODBC
If td.Attributes And dbAttachedODBC <> 0 Then
' Crée un tableau des éléments de la chaîne de connexion ODBC actuelle
strParts = Split(td.Connect, ";")
' recompose la chaîne de connexion ODBC
For i = LBound(strParts) To UBound(strParts)
If strParts(i) Like "UID=*" Then
' nouvel attribut UID
strConn = strConn & "UID=" & strUID & ";"
ElseIf strParts(i) Like "PWD=*" Then
' Nouvel attribut PWD
strConn = strConn & "PWD=" & strPWD & ";"
Else
strConn = strConn & strParts(i) & ";"
End If
Next
strConn = Left(strConn, Len(strConn) - 1)
' Modifie la propriété Connect avec la nouvelle chaîne de connexion ODBC
td.Connect = strConn
' Met à jour la liaison
On Error GoTo ERRH
td.RefreshLink
' RefreshLink recrée la table liée.
' ==> on perd l'index unique si on en avait créé un.
' Ajout index clé primaire
If Len(strUniqueRecord) > 0 Then
strCreateIdx = "CREATE UNIQUE INDEX __uniqueindex " & _
"ON [" & strTable & "] (" & strUniqueRecord & ") WITH PRIMARY"
db.Execute strCreateIdx, dbFailOnError
End If
Else
strErrMsg = "La Table '" & strTable & "' n'est pas une table liée ODBC"
End If
QUIT:
Set td = Nothing
Set db = Nothing
If Len(strErrMsg) <> 0 Then MsgBox strErrMsg
Exit Sub
ERRH:
strErrMsg = "Erreur N° " & CStr(Err.Number) & " : " & Err.Description
Select Case Err.Number
Case 3146, 3151, 3154, 3155, 3156, 3157, 3231, 3232, 3234, 3225, 3238, 3247, 3254
strErrMsg = strErrMsg & vbCrLf & vbCrLf & _
">>> Erreurs complémentaires DAO :" & vbCrLf & _
"======================"
'Récupérations Erreur(s) driver ODBC via DAO
For Each errX In DBEngine.Errors
strErrMsg = strErrMsg & vbCrLf & Format(errX.Number, "00000") & " : " & errX.Description
Next
End Select
Resume QUIT
End Sub |
Modification de liaison ODBC d'une base Access
quand, de son poste, il essaye d'ouvrir le .accde de ma base de TEST, avec les liens qui pointe sur la même source de données "base_TEST DEV", au moment d'ouvrir un formulaire qui a besoin de données, ça me fait une erreur ODBC.
et 
si la réponse vous a été utile !
Répondre avec citation
)
Partager