Can I share an MS-Access database application via Dropbox?

前端 未结 3 1829
忘了有多久
忘了有多久 2020-12-18 16:53

I have a small Access application that only 3 or 4 people will ever use, but I want them to be able to use it from different locations. Only one person will use it at a time

相关标签:
3条回答
  • 2020-12-18 17:26

    I know this is an old question, I do not think it is possible to do this safely. The issue is that LDB files, which are the files that manages the share of connections to the database can lose track of open state. This occurs when external files are joined to the primary database via JOIN/IN type constructs. When this occurs the Jet/ADO engine still has locks on files even if the application exits, as the file specified in the IN clauses is opened but not closed when the query completes. Then DropBox creates conflicted copies of files and data is lost.

    0 讨论(0)
  • 2020-12-18 17:28

    This is an enhanced version of Gord Thompsons script which tries to inform the user to help them do the "right thing".

    It also deals with exceptional behaviour such as bad internet access (it encourages the user NOT to use it!) and it also deals with the script being terminated by the user once access has been opened)

    ' This uses a second file extension (.Available or .InUse) to indicate the status of the database file,
    ' makes a local (not synced) copy inthe temp folder and opens that copy in Access.
    ' The updated file is copied back to the Dropbox folder so it can be synced.
    ' A backup fodler and file can be created with a date in the filename if the suer chooses to.
    '
    ' The launcher could be invoked by a shortcut whose target is
    '
    ' CSCRIPT.EXE C:\!AA\OpenFMFtoolDatabase.vbs
    
    ' Or to debug (it can open in VS if VS has been setup right with an external tool)
    ' CSCRIPT.EXE /X C:\!AA\OpenFMFtoolDatabase.vbs
    
    
    
    
    
    
    ' ----------------------------------------------------------------------------------------
    ' ----------------------------------------------------------------------------------------
    ' ----------------------------------------------------------------------------------------
    ' This file is used to open and backup the FMFtool university and Subject database
    '
    ' It can be invoked by a shortcut whose target is  CSCRIPT.EXE C:\!AA\OpenFMFtoolDatabase.vbs
    '
    ' See the tag #DOTHESE below for constants that need to be changed for each specific user
    
    
    'Option Explicit
    
    ' ----------------------------------------------------------------------------------------
    ' ----------------------------------------------------------------------------------------
    ' ----------------------------------------------------------------------------------------
    ' Supporting functions
    '
    Function LPad(MyString, MakeStringThisLong, PadWithThisChar)
    
      Dim n: n = 0
      If MakeStringThisLong > Len(MyString) Then n = MakeStringThisLong - Len(MyString)
      LPad = String(n, PadWithThisChar) & MyString
    
    End Function
    
    Function BuildDateForFile()
    
        Dim TheMonth, TheDay
    
        TheMonth = LPad(Month(Date), 2, "0")
        TheDay = LPad(Day(Date), 2, "0")
    
        BuildDateForFile = DatePart("yyyy", Now) & TheMonth & TheDay & "_"
    
    End Function
    
    
    ' ----------------------------------------------------------------------------------------
    ' ----------------------------------------------------------------------------------------
    ' ----------------------------------------------------------------------------------------
    ' Main Procedure
    '
    Sub OpenDatabase()
    
        ' -----------------------------------------------------------------
        ' -----------------------------------------------------------------
        ' USER / MACHINE SPECIFIC #DOTHESE
    
        Const SupportEmail = "mr@harveyfrench.co.uk"
        ' This script may prompt the user to contact support using this email address.
    
        Const DropboxFolder = "C:\!AA\DropBox\"
        ' A typical value is "C:\Users\Gord\Dropbox\dbStorage\"   Note that it must END WITH a backslash
        ' It is set to the name of the LOCAL folder (ie a folder on the PC running this script) which is synced with dropbox
        ' (or any internet based file sharing system like Dropbox, Onedrive, GDrive, etc)
    
        Const DatabaseCalled = "University and Subject Database"
        ' The name of the database file without the file extension (ie no .accdb)
    
        Const DatabaseExtension = ".accdb"
        ' The file extension (eg .accdb)
    
    
    
    
        ' -----------------------------------------------------------------
        ' -----------------------------------------------------------------
        ' General constants
        Const TemporaryFolder = 2
        Const TAGForINUSE = ".InUse"
        Const TAGForAVAILABLE = ".Available"
        Const TAGForOldLocalFile = ".OldFile"
    
    
        Dim WshShell, f, AccessPath, WorkingFolder, DatabaseName
        Dim FileNameWhenInUse, FileNameWhenAvailable
        Dim DropBoxInUse, DropBoxAvailable
        Dim DropboxBackupFolder, DropboxBackupFileName, DropboxDONOTBackupFileName
        Dim LocalFile, OldLocalFile
        Dim blnOpenLocalFile
    
    
    
    
    
        ' -----------------------------------------------------------------
        ' Use these lines when delivering the code
        Dim fso
        Set fso = CreateObject("Scripting.FileSystemObject")
    
        ' -----------------------------------------------------------------
        ' Use may use these lines when writing the code
        'Dim fso As Scripting.FileSystemObject
        'Set fso = New Scripting.FileSystemObject
    
    
    
    
        ' -----------------------------------------------------------------
        ' About files and folders
    
        DatabaseName = DatabaseCalled & DatabaseExtension
    
        FileNameWhenInUse = DatabaseName & TAGForINUSE
        FileNameWhenAvailable = DatabaseName & TAGForAVAILABLE
    
        DropBoxInUse = DropboxFolder & FileNameWhenInUse
        DropBoxAvailable = DropboxFolder & FileNameWhenAvailable
    
        DropboxBackupFolder = DropboxFolder & "Backups"
    
        WorkingFolder = fso.GetSpecialFolder(TemporaryFolder) & "\"
    
        ' eg often: C:\Users\Harvey\AppData\Local\Temp\
    
        LocalFile = WorkingFolder & DatabaseName
        OldLocalFile = LocalFile & TAGForOldLocalFile
    
        blnOpenLocalFile = False
    
        ' -----------------------------------------------------------------
        ' WARN User
        '
        If vbNo = MsgBox("This will open " & DatabaseName & vbCrLf & _
                         vbCrLf & _
                         "DO YOU HAVE ACCESS TO THE WEB?" & vbCrLf & _
                         vbCrLf & _
                         "Do not click YES unless you are sure you do as the web is needed to prevent other people from opening the above file while you have it open.  " & vbCrLf & _
                         vbCrLf & _
                         "NOTE 1: It is OK to loose web access once the file is opened - but others will not be able to use it again until you have web access (and have closed the file)." & vbCrLf & _
                         vbCrLf & _
                         "NOTE 2: If you click YES and you do not have web accesss, either you or someone else WILL LOOSE ALL changes made to the file!)", vbYesNo) Then
            Exit Sub
        End If
    
    
        ' ---------------------------------------------------------------------------------
        ' ---------------------------------------------------------------------------------
        '
        ' Main processing -
        ' The file is only opened if it is available (ie not in use by another person).
        ' It can also be opened if it is determined that the file was not copied back to the dropbox folder
        ' but was "accidentally" left in the temp folder
        ' When it is opened the file is renamed on dropbox to indicate it is unavailable
        '
        If fso.FileExists(DropBoxAvailable) Then
    
            Set f = fso.GetFile(DropBoxAvailable)
    
            ' This renames the file on dropbox to be "InUse"
            f.Name = FileNameWhenInUse
    
            '
            ' Allow dropbox to upload the file ASAP  (if possible, force dropbox to sync here )
            '
    
            WScript.Echo "Copying database file to temp folder..."
            f.Copy LocalFile
            Set f = Nothing
    
            blnOpenLocalFile = True
    
        Else
    
            If fso.FileExists(DropBoxInUse) Then
    
               If fso.FileExists(LocalFile) Then
    
                  MsgBox "The database was found locally and will be opened " & vbCrLf & _
                  vbCrLf & _
                  "(it had already been previoulsy opened by you, but not written back to the dropbox folder (perhaps a process crashed)."
    
                  blnOpenLocalFile = True
    
               Else
    
                  MsgBox "The database is currently in use by someone else. Try again later."
                  blnOpenLocalFile = False
    
               End If
    
            Else
    
                MsgBox "The database could not be found on dropbox " & vbCrLf & _
                vbCrLf & _
                "(Both " & TAGForINUSE & " and " & TAGForAVAILABLE & " versions are missing from dropbox!)."
    
    
                If fso.FileExists(LocalFile) Then
                   MsgBox "A Copy of the file exists locally on your computer.  " & vbCrLf & _
                   vbCrLf & _
                   "(The file will be opened and written back to dropbox as usual BUT - " & vbCrLf & _
                   "please email " & SupportEmail & " as this situation should not be arising!)."
    
                   blnOpenLocalFile = True
    
                Else
    
                    If fso.FileExists(OldLocalFile) Then
    
                       MsgBox "A backup copy of the local file exists (know as the OldLocalFile)" & vbCrLf & _
                       vbCrLf & "Email support on " & SupportEmail & vbCrLf & _
                       "to find out what to do (as this is a really wierd situation)."
    
                    Else
    
                       MsgBox "A backup copy of the local file DOES NOT EXIST " & vbCrLf & _
                       vbCrLf & "Email support on " & SupportEmail & vbCrLf & _
                       "..but being honest you may be in a really bad pickle, but if you've been taking backups you'll be fine!"
    
                    End If
    
                    blnOpenLocalFile = False
    
                End If
    
            End If
    
        End If
    
    
        If blnOpenLocalFile Then
    
    
            ' ---------------------------------------------------------------------------------
            ' Take a daily backup
            '
    
            If Not fso.FolderExists(DropboxBackupFolder) Then
                 WScript.Echo "Creating backup folder."
                 fso.CreateFolder DropboxBackupFolder
            End If
    
            DropboxBackupFileName = DropboxBackupFolder & "\" & BuildDateForFile() & DatabaseName
            DropboxDONOTBackupFileName = DropboxBackupFileName & ".NoBackup"
            DropboxBackupFileName = DropboxBackupFileName & ".Backup"
    
            If Not (fso.FileExists(DropboxBackupFileName)) And Not (fso.FileExists(DropboxDONOTBackupFileName)) Then
    
                If vbYes = MsgBox("Do you want to take a daily backup? " & vbCrLf & _
                                   vbCrLf & "(click YES if a lot of work has been done since the last backup was taken. " & vbCrLf & _
                                   " If in doubt click YES)", vbYesNo) Then
    
                    WScript.Echo "Creating daily backup file."
                    fso.CopyFile LocalFile, DropboxBackupFileName
    
                Else
                    ' Create an empty text file to flag no backup is wanted that day
                    WScript.Echo "No daily backup file will be created."
                    fso.CreateTextFile (DropboxDONOTBackupFileName)
    
                End If
    
            End If
    
    
            ' ---------------------------------------------------------------------------------
            ' Open the file
            '
            Set WshShell = CreateObject("WScript.Shell")
            AccessPath = WshShell.RegRead("HKEY_CLASSES_ROOT\Access.MDBFile\shell\Open\command\")
            AccessPath = Left(AccessPath, InStr(AccessPath, "MSACCESS.EXE") + 12)
    
            WScript.Echo "Launching Access and Opening temp database file: " & vbCrLf & LocalFile
    
            WshShell.Run AccessPath & " """ & LocalFile & """", 1, True
    
            WScript.Echo "Copying temp database file back to Dropbox folder..."
            fso.CopyFile LocalFile, DropBoxInUse
    
            Set f = fso.GetFile(DropBoxInUse)
            f.Name = FileNameWhenAvailable
            Set f = Nothing
    
            ' Make another copy of the file that was copied to the dropbox folder, then delete the original file
            ' (This might help stop a bad catastrophe!)
    
    
            WScript.Echo "In Temp Folder: Copying temp database file to be .oldfile"
            fso.CopyFile LocalFile, OldLocalFile
    
            WScript.Echo "In Temp Folder: Deleting temp database file "
            fso.DeleteFile LocalFile
    
        End If
    
        Set fso = Nothing
    
    End Sub
    
    ' Do the work!
    OpenDatabase
    
    0 讨论(0)
  • 2020-12-18 17:39

    I agree that using a Dropbox folder as a shared location could possibly work provided that only one person had the database open at any one time. If more than one person opened the database at the same time then when Dropbox went to sync the file it could clobber somebody else's changes, or have sync conflicts, or perhaps just get horribly confused.

    If I was to try using this approach I certainly would not rely on telling users to "always check if somebody else is using the database before opening it" or "always open the database in Exclusive mode". Instead, I would use a little launcher script like the following VBScript to manage access to the database. It uses a second file extension (.Available or .IN_USE) to indicate the status of the database file, makes a local (not synced) copy, opens that copy in Access, and then copies the updated file back to the Dropbox folder so it can be synced.

    Option Explicit
    Dim WshShell, fso, f, AccessPath, DropboxFolder, WorkingFolder, DatabaseName
    Const TemporaryFolder = 2
    
    DropboxFolder = "C:\Users\Gord\Dropbox\dbStorage\"
    DatabaseName = "myDatabase.accdb"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    WorkingFolder = fso.GetSpecialFolder(TemporaryFolder) & "\"
    If fso.FileExists(DropboxFolder & DatabaseName & ".Available") Then
        Set f = fso.GetFile(DropboxFolder & DatabaseName & ".Available")
        f.Name = DatabaseName & ".IN_USE"
        WScript.Echo "Copying database file to working folder..."
        f.Copy WorkingFolder & DatabaseName
        Set f = Nothing
    
        Set WshShell = CreateObject("WScript.Shell")
        AccessPath = WshShell.RegRead("HKEY_CLASSES_ROOT\Access.MDBFile\shell\Open\command\")
        AccessPath = Left(AccessPath, InStr(AccessPath, "MSACCESS.EXE") + 12)
    
        WScript.Echo "Launching Access..."
        WshShell.Run AccessPath & " """ & WorkingFolder & DatabaseName & """", 1, True
    
        WScript.Echo "Copying database file back to Dropbox folder..."
        fso.CopyFile WorkingFolder & DatabaseName, DropboxFolder & DatabaseName & ".IN_USE"
        Set f = fso.GetFile(DropboxFolder & DatabaseName & ".IN_USE")
        f.Name = DatabaseName & ".Available"
        Set f = Nothing
    Else
        If fso.FileExists(DropboxFolder & DatabaseName & ".IN_USE") Then
            MsgBox "The database is currently in use. Try again later."
        Else
            MsgBox "The database could not be found."
        End If
    End If
    Set fso = Nothing
    

    The launcher could be invoked by a shortcut whose target is

    CSCRIPT.EXE C:\wherever\launchMyDatabase.vbs
    
    0 讨论(0)
提交回复
热议问题