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