Acces

Signaler
Messages postés
2
Date d'inscription
vendredi 27 mars 2009
Statut
Membre
Dernière intervention
30 mars 2009
-
Messages postés
2
Date d'inscription
vendredi 27 mars 2009
Statut
Membre
Dernière intervention
30 mars 2009
-
salut a tous je suis nouveau sur le forum et j'ai un petit pb
voila je doit fair une base de donnée sous acces pour gerer le parc informatique de mon entre prise mais je suis perdu et je ne sait pas par ou commencer...le pb c'est que ma formation etait beaucoup plus reseau(cisco)et que pour moi access c'est du chinois,j'est bien essayer de telecharger des truc sur le net mais je me suis encor plus perdu car sa parle de sql et la je suis dans le noir absolu...si quelqu'un pouvait m'aider ou me filler un tutos pourn faire cette base sa m'aiderait beaucoup merci

l'homme prudent ne joue pas a saute mouton avec une licorne

6 réponses

Messages postés
550
Date d'inscription
jeudi 12 octobre 2006
Statut
Membre
Dernière intervention
6 juin 2015
4
T'ajoute la réference Microsoft DAO 3.5 OL.
Voici mon code, ta plus qu'a faire ta sauce:

----- CLSDATABASE -----

Public Sub OuvrirDataBase(szDBPath As String, Optional szPassword As String = "")
On Error GoTo GT_ERR

modDB.DAOVAR_IsOpen = False
 
    'Si base ouverte alors on la ferme avant de réouvrir la base
    If modDB.DAOVAR_IsOpen = True Then Call FermerDataBase
   
    If szPassword <> "" Then
        Set modDB.DAO_DB = OpenDatabase(szDBPath, dbDriverNoPrompt, False, ";pwd=" & szPassword)
    Else
        Set modDB.DAO_DB = OpenDatabase(szDBPath)
    End If

modDB.DAOVAR_IsOpen = True
Exit Sub

GT_ERR:
    modDB.ShowErrDB "clsDataBase.OuvrirDataBase", _
        "Une erreur est survenue lors de l'ouverture de la database"
End Sub

Public Sub FermerDataBase()
    On Error Resume Next
        modDB.DAOVAR_IsOpen = False
       
        Set modDB.DAO_FL = Nothing
               
        Set modDB.DAO_TD = Nothing
       
        modDB.DAO_RS.Close
        Set modDB.DAO_RS = Nothing
       
        modDB.DAO_DB.Close
        Set modDB.DAO_DB = Nothing
       
        modDB.DAO_WS.Close
        Set modDB.DAO_WS = Nothing
    On Error GoTo 0
End Sub

Public Sub FermerDataBaseEx()
    On Error Resume Next
        Set modDB.DAO_FL = Nothing
               
        Set modDB.DAO_TD = Nothing
        Set modDB.DAO_RS = Nothing
        Set modDB.DAO_DB = Nothing
        Set modDB.DAO_WS = Nothing
       
        modDB.DAOVAR_IsOpen = False
    On Error GoTo 0
End Sub

Public Function CreerDataBaseEx(szDBPath As String, Optional szPassword As String = "") As Boolean
Dim i As Long
On Error GoTo GT_ERR

CreerDataBaseEx = False

    'Ouverture d'un workspace
    Set modDB.DAO_WS = DBEngine.Workspaces(0)
    szDBPath = UCase(szDBPath)
   
        'Creation de la database
        If szPassword <> "" Then
            Set modDB.DAO_DB = modDB.DAO_WS.CreateDatabase(szDBPath, ";Provider=Microsoft.Jet.OLEDB.4.0;pwd=" & szPassword & dbLangGeneral, dbVersion30)
        Else
            Set modDB.DAO_DB = modDB.DAO_WS.CreateDatabase(szDBPath, dbLangGeneral)
        End If

    modDB.DAO_DB.Close
    Set modDB.DAO_DB = Nothing
    modDB.DAO_WS.Close
    Set modDB.DAO_WS = Nothing
   
CreerDataBaseEx = True
Exit Function

GT_ERR:
    modDB.ShowErrDB "clsDataBase.CreerDataBaseEx", _
        "Une erreur est survenue lors de la création de la database"
End Function

Public Function CreerTable(szNomTable As String) As Boolean
Dim szBuf As String
On Error GoTo GT_ERR
CreerTable = False

    'Verifier si erreur et si ouverte
    If modDB.CheckErr = True Then
        ShowErrDB "clsDataBase.CreerTable", "Une erreur antérieur a été detecté !", "Impossible de continuer la procédure..."
        Exit Function
    End If
    If modDB.DAOVAR_IsOpen = False Then
        ShowErrDB "clsDataBase.CreerTable", "L'ouverture antérieur de la Base a échoué !", "Impossible de créer une table dans la base..."
        Exit Function
    End If
   
        'Creation de la table
        szBuf = "TD_" & UCase(szNomTable)
        Set modDB.DAO_TD = modDB.DAO_DB.CreateTableDef(szBuf)
       
CreerTable = True
Exit Function
       
GT_ERR:
    modDB.ShowErrDB "clsDataBase.CreerTable", _
        "Une erreur est survenue lors de la création de la table"
End Function

Public Function CreerChamp(szNomChamp As String, ezType As DataTypeEnum, Optional lzTaille As Long = 0) As Boolean
Dim i As Long
On Error GoTo GT_ERR
CreerChamp = False

    'Configuration du champ
    If lzTaille = 0 Then
        Set modDB.DAO_FL = modDB.DAO_TD.CreateField(UCase(szNomChamp), ezType)
    Else
        Set modDB.DAO_FL = modDB.DAO_TD.CreateField(UCase(szNomChamp), ezType, lzTaille)
    End If
                           
        'Creation du champ dans la table
        modDB.DAO_TD.Fields.Append modDB.DAO_FL
   
    'Ajout des table/champ dans la base
    modDB.DAO_DB.TableDefs.Append modDB.DAO_TD

CreerChamp = True
Exit Function
       
GT_ERR:
    modDB.ShowErrDB "clsDataBase.CreerChamp", _
        "Une erreur est survenue lors de la création du champ"
End Function

Public Sub AjouterChamp(szNomChamp As String, ezType As DataTypeEnum, Optional lzTaille As Long = 0)
Dim i As Long
On Error GoTo GT_ERR

    'Configuration du champ
    If lzTaille = 0 Then
        Set modDB.DAO_FL = modDB.DAO_TD.CreateField(UCase(szNomChamp), ezType)
    Else
        Set modDB.DAO_FL = modDB.DAO_TD.CreateField(UCase(szNomChamp), ezType, lzTaille)
    End If
                           
        'Creation du champ dans la table
        modDB.DAO_TD.Fields.Append modDB.DAO_FL
   
Exit Sub
       
GT_ERR:
    modDB.ShowErrDB "clsDataBase.AjouterChamp", _
        "Une erreur est survenue lors de l'ajout du champ"
End Sub

Public Function OuvrirTable(szNomTable As String) As Boolean
On Error GoTo GT_ERR
OuvrirTable = False

    If modDB.DAOVAR_IsOpen = False Then
      modDB.ShowErrDB "Erreur Inattendue", "La base n'est pas ouverte...", "Il n'est pas possible d'ouvrir la table !"
      Exit Function
    End If
 
    'Initialise le record et ouvre la table
    Set modDB.DAO_RS = Nothing
    Set modDB.DAO_RS = modDB.DAO_DB.OpenRecordset("TD_" & szNomTable)

OuvrirTable = True
Exit Function
       
GT_ERR:
    modDB.ShowErrDB "clsDataBase.OuvrirTable", _
        "Une erreur est survenue lors de l'ouverture de la table"
End Function

Public Function OuvrirTableRequete(szNomTable As String, Optional DaoTypes As RecordsetTypeEnum, Optional DaoOptions As RecordsetOptionEnum, Optional DaoLocks As LockTypeEnum) As Boolean
On Error GoTo GT_ERR
OuvrirTableRequete = False

    If modDB.DAOVAR_IsOpen = False Then
      modDB.ShowErrDB "Erreur Inattendue", "La base n'est pas ouverte...", "Il n'est pas possible d'ouvrir la table !"
      Exit Function
    End If
 
    'Initialise le record et ouvre la table
    Set modDB.DAO_RS = Nothing
   
    If DaoTypes = 0 Then
        Set modDB.DAO_RS = modDB.DAO_DB.OpenRecordset(szNomTable)
    ElseIf DaoOptions = 0 Then
        Set modDB.DAO_RS = modDB.DAO_DB.OpenRecordset(szNomTable, DaoTypes)
    ElseIf DaoLocks = 0 Then
        Set modDB.DAO_RS = modDB.DAO_DB.OpenRecordset(szNomTable, DaoTypes, DaoOptions)
    Else
        Set modDB.DAO_RS = modDB.DAO_DB.OpenRecordset(szNomTable, DaoTypes, DaoOptions, DaoLocks)
    End If

OuvrirTableRequete = True
Exit Function
       
GT_ERR:
    modDB.ShowErrDB "clsDataBase.OuvrirTableRequete", _
        "Une erreur est survenue lors de l'ouverture de la table avec requête"
End Function

Public Function CompacterDataBase() As Boolean
Dim szPathBackup As String, szPathTemp As String, lzRT As Long
Dim szBuf As String

On Error GoTo GT_ERR
CompacterDataBase = False

    szPathBackup = modApp.PathBaseDirectory
    szBuf = modApp.GetFileName(modApp.PathBaseFile)
    szPathBackup = szPathBackup & "[BACKUP] " & szBuf & "_" & Format(Now, "yyyymmddhhmmss") & ".cnc"
    szPathTemp = modApp.PathBaseDirectory & modApp.GetFileName(modApp.PathBaseFile) & ".tmp"
   
            'Fait une copie de sauvegarde avant backup
            lzRT = CopyFileApi(modApp.PathBaseFile, szPathBackup, 0)
            If lzRT = 0 Then
                If MsgBox("Le programme n'a pas réussit à faire une copie de sauvegarde de la base pratique" & vbNewLine & _
                    "Il est conseillé de faire une sauvegarde par vous même." & vbNewLine & _
                    vbNewLine & "Voulez-vous faire cette sauvegarde ?", vbExclamation + vbYesNo, "Echec backup") = vbYes Then
                        MsgBox "Le programme va ouvrir le dossier contenant la base pratique !" & vbNewLine & _
                        "Faite une copie de sauvegarde du fichier suivant: " & modApp.GetFileName(modApp.PathBaseFile), vbInformation, "Attention"
                        modApp.Executer frmMain.hWnd, modApp.PathBaseDirectory
                    Exit Function
                End If
            End If
            DoEvents
       
    'Supprime de force la base temporaire
    DeleteFile szPathTemp
    'Lance le compactage
    Dim myDBE As New DBEngine
   
        Err.Clear
            myDBE.CompactDatabase modApp.PathBaseFile, szPathTemp, dbLangGeneral, False, ";pwd=cnc"
            If myDBE.Errors.Count > 0 Then
                ShowErrDB "clsDatabase.CompacterDataBase", "Erreur inattendue lors du compactage"
                Set myDBE = Nothing
                Exit Function
            End If
        Set myDBE = Nothing
       
    'Supprime la base actuel
    DeleteFile modApp.PathBaseFile
    'Remplace la base compacter
    FileCopy szPathTemp, modApp.PathBaseFile
    DoEvents
    'Supprime de force la base temporaire
    DeleteFile szPathTemp

CompacterDataBase = True
Exit Function
       
GT_ERR:
    modDB.ShowErrDB "clsDataBase.CompacterDataBase", _
        "Une erreur est survenue lors du compactage de base pratique"
End Function

Public Function RepairDataBase() As Boolean
Dim szPathBackup As String, szPathTemp As String, lzRT As Long
Dim szBuf As String

On Error GoTo GT_ERR
RepairDataBase = False

    szPathBackup = modApp.PathBaseDirectory
    szBuf = modApp.GetFileName(modApp.PathBaseFile)
    szPathBackup = szPathBackup & "[BACKUP] " & szBuf & "_" & Format(Now, "yyyymmddhhmmss") & ".cnc"
    szPathTemp = modApp.PathBaseDirectory & modApp.GetFileName(modApp.PathBaseFile) & ".tmp"
   
            'Fait une copie de sauvegarde avant backup
            lzRT = CopyFileApi(modApp.PathBaseFile, szPathBackup, 0)
            If lzRT = 0 Then
                If MsgBox("Le programme n'a pas réussit à faire une copie de sauvegarde de la base pratique" & vbNewLine & _
                    "Il est conseillé de faire une sauvegarde par vous même." & vbNewLine & _
                    vbNewLine & "Voulez-vous faire cette sauvegarde ?", vbExclamation + vbYesNo, "Echec backup") = vbYes Then
                        MsgBox "Le programme va ouvrir le dossier contenant la base pratique !" & vbNewLine & _
                        "Faite une copie de sauvegarde du fichier suivant: " & modApp.GetFileName(modApp.PathBaseFile), vbInformation, "Attention"
                        modApp.Executer frmMain.hWnd, modApp.PathBaseDirectory
                    Exit Function
                End If
            End If
            DoEvents
       
    'Lance la reparation
    Dim myDBE As New DBEngine
   
        Err.Clear
            myDBE.RepairDataBase modApp.PathBaseFile
            If myDBE.Errors.Count > 0 Then
                ShowErrDB "clsDatabase.RepairDataBase", "Erreur inattendue lors de la reparation"
                Set myDBE = Nothing
                Exit Function
            End If
        Set myDBE = Nothing
       
    'Supprime la base actuel
    DeleteFile szPathTemp
    DoEvents
   
RepairDataBase = True
Exit Function
       
GT_ERR:
    modDB.ShowErrDB "clsDataBase.RepairDataBase", _
        "Une erreur est survenue lors de la reparation de base pratique"
End Function

----- MODDATABASE -----

Global GT_ERR As Variant
Global GT_EXIT As Variant

Global DAOVAR_IsOpen As Boolean
Global HaveError As Boolean

Public DAO_WS As Workspace
Public DAO_DB As Database
Public DAO_RS As Recordset
Public DAO_QD As QueryDef
Public DAO_TD As TableDef
Public DAO_FL As Field

Public myDAO As New clsDataBase
Public Const SQL_001 As String = "SELECT TD_FICHE.*, TD_FICHE.IS_DELETED From TD_FICHE WHERE (((IS_DELETED)=0));"
Public Const SQL_002 As String = "SELECT TD_FICHE.*, TD_FICHE.IS_DELETED From TD_FICHE WHERE (((IS_DELETED)=-1));"

Public Function CheckErr() As Boolean
    CheckErr = HaveError    If HaveError True Then HaveError False
End Function

Public Sub ShowErrDB(sTitle As String, sParam1 As String, Optional sParam2 As String, Optional sParam3 As String)
Dim szBuf As String

    szBuf = sParam1 & vbNewLine & sParam2 & vbNewLine & sParam3
   
    If Err.Number <> 0 Then szBuf = szBuf & vbNewLine & vbNewLine & _
        "Informations principales:" & vbNewLine & "N° :" & Err.Number & vbNewLine & Err.Description
       
    If Err.LastDllError <> 0 Then szBuf = szBuf & vbNewLine & vbNewLine & _
        "Informations supplémentaires:" & vbNewLine & "N°: " & Err.LastDllError & vbNewLine & modApp.LastDllErrorInfo(Err.LastDllError)
       
    MsgBox szBuf, vbCritical + vbOKOnly, sTitle
   
    Err.Clear
    HaveError = True
    Call myDAO.FermerDataBaseEx
End Sub
Messages postés
550
Date d'inscription
jeudi 12 octobre 2006
Statut
Membre
Dernière intervention
6 juin 2015
4
J'te joint un exemple genre dans un bouton <Creer Database>:

        'Création de la database
        myDAO.CreerDataBaseEx sBase, "555"
        myDAO.OuvrirDataBase sBase, "555"
         
            'Creation des tables
            If myDAO.CreerTable("MAIN") = True Then
                'Creation des champs
                If myDAO.CreerChamp("NOM_FICHIER", dbText, frmCreation.txtInfo(0).MaxLength + 10) = True Then
                    myDAO.AjouterChamp "DESCRIPTION", dbText, frmCreation.txtInfo(1).MaxLength
                    myDAO.AjouterChamp "DATE_CREATION", dbDate
                    myDAO.AjouterChamp "HEURE_CREATION", dbDate
                End If
            End If
             
            'Creation des tables
            If myDAO.CreerTable("FICHE") = True Then
                'Creation des champs
                If myDAO.CreerChamp("ID", dbLong) = True Then
                    myDAO.AjouterChamp "IS_DELETED", dbBoolean
                    myDAO.AjouterChamp "NUM_PLAN", dbText
                    myDAO.AjouterChamp "DESIGNATION", dbMemo
                    myDAO.AjouterChamp "DATE", dbDate
                    myDAO.AjouterChamp "NOM_CLIENT", dbText
                    myDAO.AjouterChamp "DOCUMENT", dbText
                End If
            End If
             
      myDAO.FermerDataBase
Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Statut
Membre
Dernière intervention
30 juin 2013
14
Ca devrait être criminel d'utiliser DAO de nos jours ...
Ce truc n'est plus supporté depuis bien longtemps !
http://files.codes-sources.com/fichier.aspx?id=47361&f=IP2Country%2fCommon%2fcls_Database.cls
Messages postés
550
Date d'inscription
jeudi 12 octobre 2006
Statut
Membre
Dernière intervention
6 juin 2015
4
J'arrive a le porter du Win95 au Vista6.
Tu peux bricoler ton PE, utiliser setup factory, Alloy, les distribuables de MS, des batch regsvr32, regedit....
Et oui VB6 même avec Vista7 ! (info: MS)

N'oublions pas...  VB.NET is good... VB6 is better !
Messages postés
3983
Date d'inscription
jeudi 14 juillet 2005
Statut
Membre
Dernière intervention
30 juin 2013
14
Vista7 existe pas et n'existera jamais ...
Ce n'est pas plutôt Windows Se7en (ou Windows Seven) ?
Et pis y'a plus personne qui utilise Win95 donc on peut tout de suite oublier.
Parce que si tu pars comme ça, MS devrait encore supporter Windows 1 !!
Donc c'est conseillé de passer à ADO, car ils risquent de virer DAO ...
Messages postés
2
Date d'inscription
vendredi 27 mars 2009
Statut
Membre
Dernière intervention
30 mars 2009

salut merci de ta reponse,mais j'ais juste un petit soucis je ne comprend pas grand chose a la programmation et je ne sait pas comment ecrire ton programme ni avec quoi...l'autre truc c'est que je voudrait un logiciel que je pourait installer sur mon pcd independament du reseau et qui ne poura etre accessible que sur mon pc pour pouvoir avoir les caracteristique des pc,des uc,des ecrant,des onduleurs,des imprimante....

l'homme prudent ne joue pas a saute mouton avec une licorne