Enregistrer une base access en execution ?

Question

Salut

Est il possible , par un moyen ou un autre , denregistrer sous ... une base access en cours dexectution ?

SynePing : Logiciel de Tennis de Table 
Http://www.syneping.com

cs_CanisLupus · Answer

Salut, 
Qu'entend-tu par base access en cours d'exécution ? Qu'un ou +sieurs progs y ont accès ? et avec quel langage veux tu faire ça ?

Cordialement, CanisLupus

foliop · Answer

oui mon logiciel utilise une base pour afficher et enregistrer des infos

donc elle est tj en execution en fait, et si je veux copier le .mdb qqpart ca me marque un message derreur me disant que le fichier esst en cours dexecution

SynePing : Logiciel de Tennis de Table 
Http://www.syneping.com

cs_CanisLupus · Answer

Si tu es tout seul à utiliser la base, c simple, tu close la base, tu la sauvegarde puis tu la rouvres.
Enfin, quand je dis c simple, il faut peut-être mettre un petit temps d'attente entre le close et la copie (histoire de donner le temps à windows de faire ce qu'il faut), un truc du genre

for i = 1 to 10000 'ou plus ou moins ça dépend de ta config
doevents
next

Ensuite, quand tu rouvres la base, faut aussi rouvrir tous les recordsets que tu utilises.

S'il y a plusieurs utilisateurs, là c'est plus dur. Perso, dans ma boite, j'ai planifié une tache qui se lance la nuit et qui est chargée de sauvegarder les bases. A ces heures là, je suis sûr que les bases ne sont ouvertes par personne étant donné que le système de sécurité fait en sorte de déconnecter les utilisateurs quand ils quittent leur poste de travail. Bien entendu, ça ne m'empêche pas de loguer toute anomalie au cas où.

Mais, tout ça, c du VB6, je ne connais pas encore assez bien le VB.NET mais je pense que ça devrait être plus cool.

Cordialement, CanisLupus

Ricks27 · Answer

Salut,

Copie ce code dans un module :



Option Explicit

Private Type SHFILEOPSTRUCT
        hwnd As Long
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAnyOperationsAborted As Boolean
        hNameMappings As Long
        lpszProgressTitle As String
End Type

Private Const FO_MOVE As Long = &H1
Private Const FO_COPY As Long = &H2
Private Const FO_DELETE As Long = &H3
Private Const FO_RENAME As Long = &H4

Private Const FOF_MULTIDESTFILES As Long = &H1
Private Const FOF_CONFIRMMOUSE As Long = &H2
Private Const FOF_SILENT As Long = &H4
Private Const FOF_RENAMEONCOLLISION As Long = &H8
Private Const FOF_NOCONFIRMATION As Long = &H10
Private Const FOF_WANTMAPPINGHANDLE As Long = &H20
Private Const FOF_CREATEPROGRESSDLG As Long = &H0
Private Const FOF_ALLOWUNDO As Long = &H40
Private Const FOF_FILESONLY As Long = &H80
Private Const FOF_SIMPLEPROGRESS As Long = &H100
Private Const FOF_NOCONFIRMMKDIR As Long = &H200

Private Declare Function apiSHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Function MakeBackup() As Boolean
        Dim strMsg As String
        Dim tshFileOp As SHFILEOPSTRUCT
        Dim lngRet As Long
        Dim strSaveFile As String
        Dim lngFlags As Long
        Const cERR_USER_CANCEL = vbObjectError + 1
        Const cERR_DB_EXCLUSIVE = vbObjectError + 2
        On Local Error GoTo MakeBackup_Err
        If fDBExclusive = True Then
                Err.Raise cERR_DB_EXCLUSIVE
        End If
        strMsg = "Are you sure that you want to make a copy of the database?"
        If MsgBox(strMsg, vbQuestion + vbYesNo, "Please confirm") = vbNo Then
                Err.Raise cERR_USER_CANCEL
                lngFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY Or FOF_RENAMEONCOLLISION
                strSaveFile = CurrentDb.Name
        End If
        Screen.MousePointer = vbHourglass
        With tshFileOp
                .wFunc = FO_COPY
                .hwnd = hWndAccessApp
                .pFrom = DbName
                .pTo = Mid(DbName, 1, RInstr(DbName, ".") - 1) & " (Save du " & Format(Now, "dd-mm-yyyy") & ").mdb" & vbNullChar
                .fFlags = lngFlags
        End With
        lngRet = apiSHFileOperation(tshFileOp)        MakeBackup (lngRet 0)
        Screen.MousePointer = vbDefault
MakeBackup_End:
        Screen.MousePointer = vbDefault
        Exit Function
MakeBackup_Err:
        MakeBackup = False
        Select Case Err.Number
                Case cERR_USER_CANCEL:
                        'do nothing
                Case cERR_DB_EXCLUSIVE:
                        MsgBox "The current database " & vbCrLf & CurrentDb.Name & vbCrLf & _
                                vbCrLf & "is opened exclusively.  Please reopen in shared mode" & _
                                " and try again.", vbCritical + vbOKOnly, "Database copy failed"
                Case Else:
                        strMsg = "Error Information..." & vbCrLf & vbCrLf
                        strMsg = strMsg & "Function: MakeBackup" & vbCrLf
                        strMsg = strMsg & "Description: " & Err.Description & vbCrLf
                        strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
                        MsgBox strMsg, vbInformation, "MakeBackup"
        End Select
        Resume MakeBackup_End
        Screen.MousePointer = vbDefault
End Function

Private Function fCurrentDBDir() As String
        Dim strDBPath As String
        Dim strDBFile As String
        strDBPath = CurrentDb.Name
        strDBFile = Dir(strDBPath)
        fCurrentDBDir = Left(strDBPath, InStr(strDBPath, strDBFile) - 1)
End Function

Function fDBExclusive() As Integer
        Dim db As Database
        Dim hFile As Integer
        hFile = FreeFile
        Set db = CurrentDb
        On Error Resume Next
        Open db.Name For Binary Access Read Write Shared As hFile
        Select Case Err
                Case 0
                        fDBExclusive = False
                Case 70
                        fDBExclusive = True
                Case Else
                        fDBExclusive = Err
        End Select
        Close hFile
        On Error GoTo 0
End Function



"DbName " est en fait le chemin complet de la base de données.
Il te faut donc la renseigner.

La fonction MakeBackup sauvegarde la base de donnée en cours sous le nom DataBaseName & "(Save du " & Format(Now, "dd-mm-yyyy") & ").mdb"

Ensuite tu as juste à appeller la Fonction MakeBackup

Il y as surement mieu comme code. Mais bon ca dépanne toujours.

Ricks27

foliop · Answer

Ca ne marche pas chez moi 

ca me marque une erreur

SynePing : Logiciel de Tennis de Table 
Http://www.syneping.com

Enregistrer une base access en execution ?

5 réponses

Discussions similaires