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)
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
