Connexion ado access + fonctions outils


Télécharger le projet
Commenter

Description

Voici un petit pack de fonctions permettant la connexion à une base ACCESS.

C'est pas très original,
Mais vu qu'on me demande souvent sur le forrum, je pose ça ici.

- Connexion à la base : Call ConnexionBase()
- Femeture de la base : cnx.Close()
- Tester connexion : Call TesterConnexion(path_a_tester)
- Compacter la base : Call CompactJetDatabase(path_base)

- Formatter Booléens : BoolSQL(True) => -1
- Formatter Chaines : TXTVersSQL("texte") => 'texte'
- Formatter Numériques : NombreSQL("12.35") => '12,35'
- Formatter Dates : DateSQL("31/12/2005") => #12/31/2005#

Source / Exemple : 


' ===========
' Module SQL
' ===========
Option Explicit
Option Compare Binary

Public cnx           As New ADODB.Connection
Private dbPassWord   As String
Private URL_BASE     As String

' ===========================================
' Définir le  password pour acceder à la base
Public Sub setPasswordBase(Optional s As String = "")
  dbPassWord = s
End Sub

' ===========================================
' Ouvrir la connexion à la base MS ACCESS
Public Sub ConnexionBase()
Dim ChaineConnexion  As String
    ' Récupérer le chemin de la base depuis l'INI
    URL_BASE = LireINI("Base", "Chemin")

    On Error GoTo erreur
    ' Connexion
    ChaineConnexion = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & URL_BASE & ";Persist Security Info=False;"
    ChaineConnexion = ChaineConnexion & "Jet OLEDB:Database Password=" & dbPassWord
    cnx.Open ChaineConnexion
    Exit Sub
erreur:
   Dim path As String
   If cnx.State = 1 Then cnx.Close
   path = InputBox("Chemin", "Saisir le path de la base", App.path & "\base.mdb")
   If path = "end" Then End
   Call EcrireINI("Base", "Chemin", path)
   Resume
End Sub

' ===========================================
' Tester si la connexion est "correcte"
Public Function TesterConnexion(ByVal url As String) As Boolean
Dim ChaineConnexion  As String
    On Error GoTo erreur
    ChaineConnexion = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & url & ";Persist Security Info=False"
    cnx.Open ChaineConnexion
    cnx.Close

    MsgBox "Connexion réussie", vbInformation, "Succés de la connexion"
    TesterConnexion = True
    Exit Function
erreur:
    If cnx.State Then cnx.Close
    MsgBox "Le chemin " & url & " n'est pas valide", vbCritical, "Echec de la connexion"
    TesterConnexion = False
    Exit Function
End Function

' ===========================================
'   Compacter & Archiver la base de données
Public Sub CompactJetDatabase(ByVal Location As String, _
                              Optional BackupOriginal As Boolean = True)
Dim strBackupFile As String
Dim strTempFile As String
    On Error GoTo CompactErr
    If Len(Dir(Location)) Then
     
        'création de la copie de sauvegarde
       If BackupOriginal = True Then
           strBackupFile = App.path & "\" & "backup.mdb"
           If Len(Dir(strBackupFile)) Then Kill strBackupFile
           FileCopy Location, strBackupFile
       End If

        'Definition de la base temporaire
       strTempFile = App.path & "\" & "temp.mdb"
       If Len(Dir(strTempFile)) Then Kill strTempFile
       
       'DBEngine.CompactDatabase olddb, newdb, locale, options, password
       DBEngine.CompactDatabase Location, strTempFile, ";pwd=" & dbPassWord, , ";pwd=" & dbPassWord   ' Compacter la base courrante -> base temp
       Kill Location                                    ' Supprimer la base courrante
       FileCopy strTempFile, Location                   ' Copier base tmp -> base courrante
       Kill strTempFile
    End If
    MsgBox "La base de donnée est nettoyée", vbInformation, "Terminé"
    Exit Sub
CompactErr:
    MsgBox "Une erreur est apparue lors du nettoyage de la base de données", vbInformation, "Erreur détectée"
    Exit Sub
End Sub

' ===========================================
' Formatter les chaines
Function TXTVersSQL(message As String) As String
  message = Replace(message, Chr(39), "''")
  TXTVersSQL = Chr(39) & message & Chr(39)
End Function

' ===========================================
' Formatter les booléens
Public Function BoolSQL(ByVal bBool As Boolean) As String
    BoolSQL = IIf(bBool, "-1", "0")
End Function

' ===========================================
' Formatter les valeurs numériques
Public Function NombreSQL(ByVal nb As String) As String
    If nb = "" Then
        NombreSQL = 0
    Else
        NombreSQL = Chr(39) & Replace(nb, ".", ",") & Chr(39)
    End If
End Function

' ===========================================
'Convertie une date au format jj/mm/aaaa au format US : mm/jj/aaaa
Public Function DateSQL(ByVal datej As String) As String
Dim jour() As String
Dim poSp As Integer
  ' suppression de l'heure si existe
  poSp = InStr(1, datej, " ")
  If poSp > 0 Then datej = Mid(datej, 1, poSp - 1)
  
  'Mise en forme
  jour = Split(datej, "/")
  Dim nbVal As Single
  
  nbVal = UBound(jour)
  If nbVal = 2 Then
    DateSQL = Chr(35) & jour(1) & Chr(47) & jour(0) & Chr(47) & jour(2) & Chr(35)
  ElseIf nbVal = 1 Then
    DateSQL = Chr(35) & jour(0) & "/01/" & jour(1) & Chr(35)
  Else
    DateSQL = Chr(35) & "01/01/" & datej & Chr(35)
  End If
End Function

' ===========================================
' Comment utiliser les requêtes de type select
' ===========================================
Dim rs          As ADODB.Recordset
Dim sql         As String
dim nbVal       As Integer

Set rs = New ADODB.Recordset 'Allocation

sql = "SELECT Champ FROM table"

Call ConnexionBase
rs.Open sql, cnx, adOpenStatic, adLockReadOnly 'Execution de la requête

nbVal = rs.RecordCount
If (nbVal = 0) Then
    MsgBox "No result"
Else
    Dim i As Integer
    For i=1 To nbVal
        MsgBox i & ") Champ  = " & rs("Champ")
        rs.MoveNext 'suivant
    Next i
End If

rs.Close          'Fermer le recordset
Set rs = Nothing  'Libération de la mémoire allouée
cnx.Close         'Fermer la connexion à la base

' ===========================================
' Pour Update, Insert, Delete ...
' ===========================================
Dim sql As String

sql = "UPDATE table SET "
sql = sql & "Champ = " & TXTVersSQL(txtValeurChamp.Text) & " "
sql = sql & "WHERE id= " & id.Text & ";"

Call ConnexionBase
cnx.Execute sql
cnx.Close

Conclusion :


Voilà, en espérant que ça aide certains...

++

Zlub
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (Zlub)