' ************************************************************************************************************** '
' '
' Module contenant deux fonctions de connections ADO à une base donnée Access sécurisé par groupe de travail '
' (mdw) '
' La première méthode utilise un DNS pré-définis sur le poste de travail et dans lequel ont aura pris soin de '
' définir le fichier mdw du groupe de travail sur lequel ont travail pour ouvrire la base de donnée '
' '
' La seconde est une connection directe sans DNS '
' '
' '
' ************************************************************************************************************** '
Public Function ConnDNS(NomDuDNS As String, UserName As String, Password As String) As Boolean
On Error GoTo Err_ConnStrait
Dim Cnx As New ADODB.Connection
Dim strConn As String
ConnDNS = False
' Nom que vous avez donné à votre DNS lorsque vous l'avez créé
NomDuDNS = "XXXXXX" ' dans l Administrateur de Sources de données (ODBC)
' du Panneau de configuration de Microsoft Windows
' initialise la chaine de connexion
strConn = "DNS=" & NomDuDNS & ";"
' vérifie que la connexion est bien fermée
If Cnx.State = adStateOpen Then
Cnx.Close
End If
' Connexion à la base de donnée
Cnx.Open ConnectionString:=strConn, UserID:=UserName, Password:=Password
' Attente jusqu'à la connexion effective
While (Cnx.State = adStateConnecting)
DoEvents
Wend
'
Vérification des erreurs éventuelles engendrés par la connexion ou attribution de la valeur "True" à la connexion
If Cnx.Errors.Count > 0 Then
MsgBox Cnx.Errors.Item(0)
ConnDNS = False
Exit Function
Else:
ConnDNS = True
End If
Exit Function
Err_ConnStrait:
MsgBox err.Description
ConnDNS = False
Exit Function
End Function
Public Function ConnStrait(UserName As String, Password As String) As Boolean
On Error GoTo Err_ConnStrait
Dim Cnx As New ADODB.Connection
Dim strConn As String
ConnStrait = False
' Initialise la chaine de connexion
strConn = "Data Source=C:\...\NomDuFichier.MDB;" & _
"Jet OLEDB:System database=C:\...\NomDuFichier.MDW"
Cnx.Provider = "Microsoft.Jet.OLEDB.4.0"
' vérifie que la connexion est bien fermée
If Cnx.State = adStateOpen Then
Cnx.Close
End If
' Connexion à la base de donnée
Cnx.Open ConnectionString:=strConn, UserID:=UserName, Password:=Password
' Attente jusqu'à la connexion effective
While (Cnx.State = adStateConnecting)
DoEvents
Wend
' Vérification des erreurs eventuelles ou attribution de la valeur "True" à la connexion
If Cnx.Errors.Count > 0 Then
MsgBox Cnx.Errors.Item(0)
ConnStrait = False
Exit Function
Else:
ConnStrait = True
End If
Exit Function
Err_ConnStrait:
MsgBox err.Description
ConnStrait = False
Exit Function
End Function