Créer un lien odbc access ou oracle automatiquement

Description

Eh bien voilà mon premier source. Il permet de créer, supprimer ou modifier un lien ODBC vers une base access ou oracle.

Le code ci-dessous est en deux parties : une pour access, l'autre pour oracle. A vous de choisir celle que vous voulez.

Source / Exemple :


'Module contenant les fonctions d'ajout et de suppression des dsn vers
Access

'Constant Declaration
Private Const ODBC_ADD_DSN = 1        ' Ajoute un dsn
Private Const ODBC_CONFIG_DSN = 2     ' Configure le dsn
Private Const ODBC_REMOVE_DSN = 3     ' Supprime le dsn

Private Const ODBC_ADD_SYS_DSN = 4        ' Ajout d'une source système
Private Const ODBC_CONFIG_SYS_DSN = 5     ' Configure la  source système
Private Const ODBC_REMOVE_SYS_DSN = 6     ' Supprime la source système
Private Const vbAPINull As Long = 0&   'Pointeur NULL

'Déclaration des API's

    Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" _
    (ByVal hwndParent As Long, ByVal fRequest As Long, _
    ByVal lpszDriver As String, ByVal lpszAttributes As String) _
    As Long

Public Function AddDSNA(FileName As String, Nom_du_DSN As String) As Boolean

    Dim intRet As Long

    Dim strDriver As String
    Dim strAttributes As String

    'Indique le driver Access
    strDriver = "Microsoft Access Driver (*.mdb)"

    'Indique les attributs delimités par le caractère null.
    'Indique le nom du DSN ainsi que son chemin d'accès
    strAttributes = strAttributes & "DSN=" & Nom_du_DSN & Chr$(0)
    strAttributes = strAttributes & "DBQ=" & FileName & Chr$(0)

    intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, _
    strDriver, strAttributes)

    AddDSNA = CBool(intRet)

   If AddDSNA = True Then
    '    MsgBox "ok pour dsn access"
    Else
        MsgBox "Une erreur s'est produite lors de la connexion à la base de
données Access.  " _
             & "Veuillez vérifier si le chemin est correct et retenter une
connexion. Si le " _
             & "problème persiste, veuillez contacter votre administrateur"
        cheminaccess.Show
    End If
End Function

Public Function DeleteDSNA(Nom_du_DSN As String) As Boolean

    Dim intRet As Long

    Dim strDriver As String
    Dim strAttributes As String

    'Indique le driver Access.
    strDriver = "Microsoft Access Driver (*.mdb)"

    'Indique les attributs délimités par le caractère null.
    'Indique le nom du DSN à supprimer

    strAttributes = "DSN=" & Nom_du_DSN & Chr$(0)
    intRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, _
    strDriver, strAttributes)

     DeleteDSNA = intRet
   '  If DeleteDSNA = True Then
   '     MsgBox "DSN access détruit"
   ' Else
   '     MsgBox "DSN access non-détruit"
   ' End If
End Function

'Module contenant les fonction d'ajout et de suppression de DSN vers Oracle
' Declaration des constantes

Option Explicit

Private Const ODBC_ADD_DSN = 1 ' Ajout d'une source de données

Private Const ODBC_CONFIG_DSN = 2 ' Configuration d'une souce de données

Private Const ODBC_REMOVE_DSN = 3 ' Suppression d'une source de données

'Private Const ODBC_ADD_SYS_DSN = 4 ' Ajout d'une source système

Private Const vbAPINull As Long = 0& ' Pointeur NULL

'Déclaration des APIs
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" ( _
ByVal hwndParent As Long, ByVal fRequest As Long, ByVal _
lpszDriver As String, ByVal lpszAttributes As String) As _
Long

Global Nom_du_DSN_Oracle As String

'Ajout du DSN
Public Function AddDSNO(Nom_du_server As String, Nom_du_DSN As String) As
Boolean

Dim intRet As Long
Dim strDriver As String
Dim strAttributes As String

'Création du dsn temporaire

' Utilisation du driver ODBC oracle.
 strDriver = "Microsoft ODBC for Oracle"

'Initialisation des attributs en les séparant par le caractère Null.
strAttributes = "SERVER=" & Nom_du_server & Chr$(0)
strAttributes = strAttributes & "DESCRIPTION=DSN Temporaire" & Chr$(0)
strAttributes = strAttributes & "DSN=" & Nom_du_DSN & Chr$(0)

intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, _
strDriver, strAttributes)

Nom_du_DSN_Oracle = Nom_du_DSN

'If intRet Then
'    MsgBox "DSN Créé"
'Else
'    MsgBox "Echec lors de la création du DSN"
'End If
End Function

'Suppression du DSN
Public Function DeleteDSNO(Nom_du_DSN As String) As Boolean

Dim intRet As Long
Dim strDriver As String
Dim strAttributes As String

strDriver = "Microsoft ODBC for Oracle"

' Initialisation des attributs en les séparant par le caractère Null.

 strAttributes = "DSN=" & Nom_du_DSN & Chr$(0)

intRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, _
strDriver, strAttributes)

If intRet Then
   ' MsgBox "DSN supprimé"
    MDIForm1.campagne.Enabled = False
    MDIForm1.connexion.Enabled = True
Else
   ' MsgBox "Echec de suppression du DSN"
End If

End Function

Et pour les appeler :

'Création du DSN oracle
AddDSNO "nom_du_serveur", "nom_de_ton_dsn"

'Suppression DSN oracle
DeleteDSNO "nom_de_ton_dsn"

Création du DSN Access
AddDSNA chemin_de_ta_bd,"nom_de_ton_dsn"

Suppression du DSN Access
DeleteDSNA "nom_de_ton_dsn"

Conclusion :


Voili, Voilou. Le zip joint créer un ODBC "exemple" vers une base acess nommé "baseDeDonnées.mdb".

Soyez-pas trop méchant, c'est ma première contribution ;-)

Stéphane

Stéphane

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.