Go Back   Access World Forums > Microsoft Access Discussion > Modules & VBA

 
Reply
 
Thread Tools Rate Thread Display Modes
Old 10-02-2005, 05:55 AM   #1
Malcy
Newly Registered User
 
Join Date: Mar 2003
Location: Edinburgh, Scotland
Posts: 586
Thanks: 1
Thanked 0 Times in 0 Posts
Malcy
Stumped on backup code

Hi
I have used this code on a few databases and it works fine. I have put it in a new Db and it was working but when I went to test it today I got a "You have tried to open a database that is already exclusively opened by ...."
I have checked and the permission is for Shared on both the FE and the BE.
I tried the code from behind a button in another DB just incase something had jumbled on my system and it works 100% OK.
Anyone any ideas where to look?
For the record, the code is (apologies for the length)
Code:
'' Based on VBA from OldSoftBoss on Access Forum, with modifications for multiple file naming

' Identify the user identity
    lngDbOp = DLookup("lngStaff", "tblStaffLogon")
        
' Define the message content
    strMsgComplete = "The compact, backup and zip of the BTBS Beneficiaries file was successful."
    strTitleComplete = "BTBS Beneficiaries Backup Complete"

' Identify the day of the week
    intDayNo = DatePart("w", Date)

' Verify that the backup directory exists and if not, create it



'' Compact the backend database
' Path where backend database is located
    strSource = DLookup("strBePath", "tblFilePaths")
' Path for temporary backup file
    strBack = DLookup("strBackupDb", "tblFilePaths")
' Path for backup file
    strBack1 = DLookup("strBackup1Db", "tblFilePaths")
    
    'Compact the Back-End database to a temp file.
    DBEngine.CompactDatabase strSource, strBack

    'Delete the previous backup file if it exists.
    If Dir(strBack1) <> "" Then
        Kill strBack1
    End If

    'Rename the current database as backup and rename the temp file to the original file name.
    Name strSource As strBack1
    Name strBack As strSource

'' Backup the database
BeginBackup:
  
  DoCmd.Hourglass True
        
' Path where backend database is located
    strSource = DLookup("strBePath", "tblFilePaths")

' Destination where data file is to be copied
    Select Case intDayNo
        Case 1
            strDest = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackSun.mdb"
            strFileToZip = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackSun.mdb"
            strZipFile = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackSun.zip"
        Case 2
            strDest = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackMon.mdb"
            strFileToZip = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackMon.mdb"
            strZipFile = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackMon.zip"
        Case 3
            strDest = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackTue.mdb"
            strFileToZip = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackTue.mdb"
            strZipFile = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackTue.zip"
        Case 4
            strDest = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackWed.mdb"
            strFileToZip = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackWed.mdb"
            strZipFile = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackWed.zip"
        Case 5
            strDest = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackThu.mdb"
            strFileToZip = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackThu.mdb"
            strZipFile = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackThu.zip"
        Case 6
            strDest = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackFri.mdb"
            strFileToZip = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackFri.mdb"
            strZipFile = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackFri.zip"
        Case 7
            strDest = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackSat.mdb"
            strFileToZip = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackSat.mdb"
            strZipFile = DLookup("strBackPath", "tblFilePaths") & "\" & "MgmBtbsBeBackSat.zip"
    End Select
        
' Check to see if a backup file of the same name already exists, and if so, delete it
    If Dir(strDest) <> "" Then
        Kill strDest
    End If

' Copy the backend database to the backup destination
    FileCopy strSource, strDest
        DoCmd.Hourglass False
  
  
'' Create a zip file copy
' Define location of the WinZip programme
    strWinZip = "C:\Program Files\WinZip\WinZip32.exe"

' Check to see if a zip file of the same name already exists, and if so, delete it
    If Dir(strZipFile) <> "" Then
        Kill strZipFile
    End If

' Run the WinZip process
    Call Shell(strWinZip & " -a " & strZipFile & " " & strFileToZip, vbNormalFocus)
    Pause (5)
' Note, if not an evaluation version of WinZip change vbNormalFocus to vbHide

' Full backup process has completed - Give Successful Completion Message
      MsgBox strMsgComplete, vbInformation + vbOKOnly, strTitleComplete
        
    
    Set cnn = CurrentProject.Connection
    Set rst = New ADODB.Recordset
        
' Record the details in the database management log
    rst.Open "tblDbLog", cnn, adOpenDynamic, adLockOptimistic
        With rst
            .AddNew
                .Fields("dtmLogD") = Now()
                .Fields("lngLogOp") = lngDbOp
                .Fields("lngLogAct") = 5
            .Update
                        
            .AddNew
                .Fields("dtmLogD") = Now()
                .Fields("lngLogOp") = lngDbOp
                .Fields("lngLogAct") = 6
            .Update
            .Close
        End With

__________________
Malcy
Solve one problem and create another!!!
Malcy is offline   Reply With Quote
Old 10-02-2005, 07:13 AM   #2
Malcy
Newly Registered User
 
Join Date: Mar 2003
Location: Edinburgh, Scotland
Posts: 586
Thanks: 1
Thanked 0 Times in 0 Posts
Malcy
Ah
May have wrongly attributed code (or at least partly) since ghudson seems to have been majorly involved.
Apologies but still stumped!!
__________________
Malcy
Solve one problem and create another!!!
Malcy is offline   Reply With Quote
Reply

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Create backup of db in vb code szymek_d Modules & VBA 2 06-24-2005 07:43 PM
[SOLVED] Running code that is OnClick on labels Mike375 Modules & VBA 1 06-19-2004 05:38 AM
Class module code runs twice Atomic Shrimp Modules & VBA 7 03-14-2001 03:14 AM
form open & close code mixup arage Modules & VBA 1 01-27-2001 07:48 AM




All times are GMT -8. The time now is 03:57 AM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Sponsored Links

How to advertise

Media Kit


Powered by vBulletin®
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World