Reuse code in Module

[Dairy Farmer]

I have a startup form that calls 3 function

Private Sub Form_Open(Cancel As Integer)
    Farm1File
    Farm2File
    FarmsFile
End Sub

These check that the 3 BE files exist.

The Module is as below, but has 3 identical functions. Only the blue text is different:

Function [COLOR="blue"]Farm1File[/COLOR]()

Dim Msg, Style, Title, Response, MyString
Dim pubInputFolder As String
Dim txtfolder As String
Dim fs As Object
Dim backupsource As String
Dim destination As String
Dim Farm As String
Dim DataPath As String

    DataPath = CurrentProject.Path & "\Data\"
    [COLOR="Blue"]Farm = "Farm_1.accdb"[/COLOR]
    If Dir(DataPath & Farm) = "" Then

        Msg = ("You are missing the data file " & Farm & "." & vbNewLine & _
                vbNewLine & _
                "Would you like to restore data from a previous backup?")
                
        Style = vbYesNo + vbCritical + vbDefaultButton1
        Title = "Missing Data"
        Response = MsgBox(Msg, Style, Title)

        If Response = vbNo Then
            MyString = "Cancel"
            DoCmd.Quit

        Else

        If Response = vbYes Then
            MyString = "Yes"


Const conPATH_FILE_ACCESS_ERROR = 75

    On Error GoTo 0
    
    With Application.FileDialog(4)
        .InitialFileName = CurrentProject.Path & "\Backups\"
        .AllowMultiSelect = False
        .Filters.Clear
        .Show
        pubInputFolder = .SelectedItems(1)
        txtfolder = pubInputFolder

    End With

    backupsource = txtfolder
    destination = CurrentProject.Path & "\Data\"

On Error GoTo Restore

    MkDir destination

Resume Restore
    
Restore:

    Set fs = CreateObject("Scripting.FileSystemObject")
        fs.CopyFile backupsource & "\" & Farm, destination & "\"
    Set fs = Nothing

    MsgBox "File " & Farm & " from " & vbNewLine _
            & backupsource & vbNewLine & _
           "successfully restored!" & vbNewLine & _
           vbNewLine & _
           "Please re-open Dairy Manager.", vbInformation, "Restore Successful"
            
    DoCmd.Quit

            End
         
         End If
        End If
    End If
End Function

How could I reuse the same code for all three functions only changing Farm?
Or should I be looking at having the code checking all three files in one shot?

 

[hk1]

I changed your Function to a sub. It doesn't return any value so it doesn't need to be a function.

Private Sub Form_Open(Cancel As Integer)
    Call CheckFile("Farm_1.accdb")
    Call CheckFile("Farm_2.accdb")
    Call CheckFile("Farm_3.accdb")
End Sub


Sub CheckFile(FarmFile as String)

Dim Msg, Style, Title, Response, MyString
Dim pubInputFolder As String
Dim txtfolder As String
Dim fs As Object
Dim backupsource As String
Dim destination As String
Dim Farm As String
Dim DataPath As String

    DataPath = CurrentProject.Path & "\Data\"
    If Dir(DataPath & FarmFile) = "" Then

        Msg = ("You are missing the data file " & Farm & "." & vbNewLine & _
                vbNewLine & _
                "Would you like to restore data from a previous backup?")
                
        Style = vbYesNo + vbCritical + vbDefaultButton1
        Title = "Missing Data"
        Response = MsgBox(Msg, Style, Title)

        If Response = vbNo Then
            MyString = "Cancel"
            DoCmd.Quit

        Else

        If Response = vbYes Then
            MyString = "Yes"


Const conPATH_FILE_ACCESS_ERROR = 75

    On Error GoTo 0
    
    With Application.FileDialog(4)
        .InitialFileName = CurrentProject.Path & "\Backups\"
        .AllowMultiSelect = False
        .Filters.Clear
        .Show
        pubInputFolder = .SelectedItems(1)
        txtfolder = pubInputFolder

    End With

    backupsource = txtfolder
    destination = CurrentProject.Path & "\Data\"

On Error GoTo Restore

    MkDir destination

Resume Restore
    
Restore:

    Set fs = CreateObject("Scripting.FileSystemObject")
        fs.CopyFile backupsource & "\" & FarmFile, destination & "\"
    Set fs = Nothing

    MsgBox "File " & FarmFile & " from " & vbNewLine _
            & backupsource & vbNewLine & _
           "successfully restored!" & vbNewLine & _
           vbNewLine & _
           "Please re-open Dairy Manager.", vbInformation, "Restore Successful"
            
    DoCmd.Quit

            End
         
         End If
        End If
    End If
End Sub

 

[hk1]

BTW, I hate to be pessimistic but I can't see where this procedure is ever going to be of any value. How do you expect the files to suddenly disappear? It's far more likely that your users will have database corruption in which case this procedure won't help at all because it will find the files and assume everything is fine.

 

[Dairy Farmer]

Thanks it works great. Now I just need to find a Compact & Repair code that works with 2007. I need to have the code run for all 3 files. Currently the code quits the app after restoring a single file and the user needs to reopen the app manually.

The app is designed to share data between farms using "sneakerware". So the BE files are not on a shared resource. They reside in a sub folder (Data) of the app. Users are given the option to backup everytime the app closes. In the event that the user deletes any of the 3 files, they need to recover them. In the app there is a restore proceedure on the "switchboard", but the "switchboard" uses data from the BE, so it won't open if any of the files are missing and the app "stalls". Hence the need to check the file exist when the app opens.

Each farm is responsable for their own data. They don't edit the other farm's data. It is only used for comparisons forms and graphs. Farms swap BE files on a regular basis, but only the BE file for that farm (i.e. Farm1 sends Farm_1.accdb to Farm2 who replaces the file in the BE folder). Hence the need to have 3 BE files (one for each farm and one "Admin" file). This does away with the need to have data replication.

I think I have made it as fool proof as possible.

 

[hk1]

You can compact and repair with this code:

Call CompactBackendDatabaseFile_Custom(CurrentProject.Path & "\Data\Farm_1.accdb", CurrentProject.Path & "\Data\Farm_1Temp.accdb", False, False)
Call CompactBackendDatabaseFile_Custom(CurrentProject.Path &  "\Data\Farm_2.accdb", CurrentProject.Path &  "\Data\Farm_2Temp.accdb", False, False)
Call CompactBackendDatabaseFile_Custom(CurrentProject.Path &  "\Data\Farm_3.accdb", CurrentProject.Path &  "\Data\Farm_3Temp.accdb", False, False)

Public Sub CompactBackendDatabaseFile_Custom(strPathFilename_OriginalBEDB As String, _
        strPathFilename_TemporaryBEDB As String, blnKeepBackup As Boolean, Optional bSuppressErrors As Boolean = False)

        'http://www.accessmvp.com/KDSnell/VBA_Functions.htm
        
        ' strPathFilename_OriginalBEDB is the path and filename of the
        '      ACCESS file that you want to compact
        ' strPathFilename_TemporaryBEDB is the path and filename that
        '      you want the function to use for the temporary copy of
        '      the ACCESS file that the function will create as part
        '      of how the function does the compacting (NOTE: if you
        '      want to keep a copy of the backend file as a backup
        '      (archive) copy, the function will add a date/time
        '      stamp to the end of the filename)
        ' blnKeepBackup tells the function if you want to have it
        '      keep a copy of the ACCESS file as a backup copy or not
        '      (value of 0 or False tells the function to not keep
        '      a copy of the compacted file as a backup copy; -1 or
        '      True tells the function to keep a copy of the compacted
        '      file as a backup copy)

        ' The function returns an INTEGER value:
        '       -1     If a "lock file" (".ldb") exists for the original file, indicating that the
        '                     file is in use (no compaction was done)
        '        0     If no errors were encountered during the compaction process
        '        1     If the original file cannot be found (no compaction done)
        '        2     If an error was encountered during the compaction (no compaction done)

        Dim intLocation As Integer
        Dim xlngLooping As Long
        Dim strTempBEDB As String, strTemp As String
        Dim strDrive As String, strDateTime As String

        Const strLockFileExtension As String = "ldb"

        On Error Resume Next

        strDateTime = Format(Now, "mmmddyyyyhhnnssAmPm")
        strTempBEDB = strPathFilename_TemporaryBEDB
        intLocation = InStrRev(strTempBEDB, "\")
        strTempBEDB = Left(strTempBEDB, intLocation) & strDateTime & _
              Mid(strTempBEDB, intLocation + 1)

        If Dir(Left(strPathFilename_OriginalBEDB, Len(strPathFilename_OriginalBEDB) - 3) & _
              strLockFileExtension) = "" Then

              On Error GoTo Err_Compact_1

              Name strPathFilename_OriginalBEDB As strTempBEDB
              DoEvents

              On Error GoTo Err_Compact_2

              DBEngine.CompactDatabase strTempBEDB, strPathFilename_OriginalBEDB
              DoEvents
              Do Until Dir(strPathFilename_OriginalBEDB) <> ""
                    On Error Resume Next
                    For xlngLooping = 0 To 25
                          DoEvents
                   Next xlngLooping
              Loop

              On Error Resume Next

              If blnKeepBackup = False Then _
                    Kill strTempBEDB

              CompactBackendDatabaseFile_Custom = 0

        Else
              CompactBackendDatabaseFile_Custom = -1

        End If

Exit_Compact:
              Exit Sub


Err_Compact_1:
              On Error Resume Next
            If bSuppressErrors = False Then
                MsgBox "The original database file cannot be found at this location:" & _
                    vbCrLf & " " & strPathFilename_OriginalBEDB & vbCrLf & _
                   "The file cannot be compacted."
            End If
             CompactBackendDatabaseFile_Custom = 1
             Resume Exit_Compact


Err_Compact_2:
              On Error Resume Next
              Kill strPathFilename_OriginalBEDB
              FileCopy strTempBEDB, strPathFilename_OriginalBEDB
            If bSuppressErrors = False Then
                MsgBox "An error occurred during the compacting operation of the file!" & _
                      vbCrLf & _
                      "The file cannot be compacted."
            End If
              CompactBackendDatabaseFile_Custom = 2
              Resume Exit_Compact

        End Sub

 

[boblarson]

To hk1 - There's nothing wrong with using a function instead of a sub even if the function does not return anything. In fact, it can be necessary since subs are not able to be seen by macros or control sources and they need to be functions if called from there. So I don't use Subs anymore. I use functions exclusively.

To DairyFarmer -

What is the purpose of this code? It will have no use to make sure a file is available before linking (as you have it set now) if the purpose is to determine if the file is available for a currently linked table. The program will generate an error before your code would run if it is missing and currently linked. If it is just to check for files that are NOT currently linked then that is another matter. But if you want to check for currently linked ones, you MUST call the function from an AutoExec macro which is the only thing that runs before links are checked.

 

[Dairy Farmer]

The app opens with one of two splash screeens (_Splash1 or _Splash2). The splash screen that opens at next startup is dictated by a field (ComboFarm) on the "switchboard" (F_0_Main) and is set when the app closes.

Private Sub Button_Quit_Click()
    Select Case Forms!F_0_Main!ComboFarm
        Case 1
            CurrentDb().Properties("StartupForm") = "_Splash1"
            On Error Resume Next
        Case 2
            CurrentDb().Properties("StartupForm") = "_Splash2"
            On Error Resume Next

        Case 3 Or 4
            CurrentDb().Properties("StartupForm") = "_Splash1"
            On Error Resume Next
    End Select

The splash screen sets what the field (ComboFarm) for the "switchboard" (F_0_Main) must be on open. As well as does a date check (F_1_DateCheck).

Private Sub Form_Load()
    DoCmd.OpenForm "F_1_DateCheck", acNormal, "", "", , acHidden
    DoCmd.OpenForm "F_0_Main", acNormal, "", "", , acNormal
    Forms!F_0_Main!ComboFarm = 1

On Error Resume Next
    DoCmd.Close acForm, "_Splash1"
End Sub

Now I have added the function/procedure that checks that the 3 BE files exist before trying to go to the "switchboard" (Form_Open) because everything after this requires the BE files. If any of them are missing the app will "stall" and the user is left with a blank screen.

To confirm, the app resides on stand alone pc's. There is no way that the BE can be on a shared resource. The BE files are used locally only. Distribution is by sneakerware (usb stick).

The code, as a function (which I prefer) or procedure works. I just need to be able to run it to check all three files, then, if one or more is missing, restore them. Lastly I need to reopen the app. Hence wanting to run Compact & Repair as this is the only way of automatically closing and opening the app.

I prefer not to use macros at all in my apps. This includes Autoexec macro.

If I want to move "Sub CheckFile(FarmFile As String)" back to a module, what syntax must I change?

 

[boblarson]

I prefer not to use macros at all in my apps. This includes Autoexec macro.

I told you - if you don't want the app to throw an error you MUST (no option here) use an AutoExec macro to run the code to check for the links and relink if necessary. If you don't you will get an error that you can't handle and the user will not be able to use the program - period. Got it? There is no option here. If you have linked tables and you want to handle if any are missing, then the only way to avoid the error is either let the user hold the shift key down and have access to the Linked Table Manager (which I'm guessing you don't want to do) or you run the code from the AutoExec macro.

 

[Dairy Farmer]

The code works fine. I have tested it a number of times using various variations. I moved the "Sub CheckFile(FarmFile As String)" to a module so I don't have to duplicate the code in each of the two slash forms.

Because the code runs in the Form_Open procedure all the file checking is done before the form loads. If a file is missing the code to restore/cancel runs and the app quits. This happens before the Form_Load procedure. Therefore if any table is missing the app quits and cannot stall. Only once the code is entirly satisfied that all 3 files exist in the correct folder will the Form_Load procedure run.

Bob, I understand exactly what you are saying about the Autoexec macro, but does the macro not run after the startup options? I know that you can use the macro instead of startup options, but I need to specify what the Farm number is, by what it is at exit, for the next startup. I could have a field in one of the tables that sets this.

You can also create an AutoExec macro to carry out an action whenever an Access file opens. You can use the Startup dialog box instead of or in addition to an AutoExec macro. An AutoExec macro runs after the startup options have taken effect; therefore, you should avoid any actions in an AutoExec macro that change the effect of the startup option settings. For example, if you specify a form in the Display Form/Page box in the Startup dialog box, and you also use the OpenForm action in an AutoExec macro, Microsoft Access first displays the form specified in the Startup dialog box, then immediately displays the form specified in the OpenForm action.

Source: Microsoft