Acces
GFTELECOM
Messages postés
2
Date d'inscription
vendredi 27 mars 2009
Statut
Membre
Dernière intervention
30 mars 2009
-
27 mars 2009 à 16:34
GFTELECOM Messages postés 2 Date d'inscription vendredi 27 mars 2009 Statut Membre Dernière intervention 30 mars 2009 - 30 mars 2009 à 09:45
GFTELECOM Messages postés 2 Date d'inscription vendredi 27 mars 2009 Statut Membre Dernière intervention 30 mars 2009 - 30 mars 2009 à 09:45
6 réponses
Duke49
Messages postés
552
Date d'inscription
jeudi 12 octobre 2006
Statut
Non membre
Dernière intervention
24 janvier 2023
4
27 mars 2009 à 17:45
27 mars 2009 à 17:45
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
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
Duke49
Messages postés
552
Date d'inscription
jeudi 12 octobre 2006
Statut
Non membre
Dernière intervention
24 janvier 2023
4
27 mars 2009 à 17:49
27 mars 2009 à 17:49
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
'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
cs_ghuysmans99
Messages postés
3982
Date d'inscription
jeudi 14 juillet 2005
Statut
Membre
Dernière intervention
30 juin 2013
16
28 mars 2009 à 13:33
28 mars 2009 à 13:33
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
Ce truc n'est plus supporté depuis bien longtemps !
http://files.codes-sources.com/fichier.aspx?id=47361&f=IP2Country%2fCommon%2fcls_Database.cls
Duke49
Messages postés
552
Date d'inscription
jeudi 12 octobre 2006
Statut
Non membre
Dernière intervention
24 janvier 2023
4
28 mars 2009 à 13:54
28 mars 2009 à 13:54
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 !
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 !
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
cs_ghuysmans99
Messages postés
3982
Date d'inscription
jeudi 14 juillet 2005
Statut
Membre
Dernière intervention
30 juin 2013
16
28 mars 2009 à 15:29
28 mars 2009 à 15:29
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 ...
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 ...
GFTELECOM
Messages postés
2
Date d'inscription
vendredi 27 mars 2009
Statut
Membre
Dernière intervention
30 mars 2009
30 mars 2009 à 09:45
30 mars 2009 à 09:45
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
l'homme prudent ne joue pas a saute mouton avec une licorne