Using a Fie SaveAs Dialog Box to save the current DB

[sheusz]

Hi all

Apologies if this is in the wrong section, but my question didn't seem to fit with the Import/Export Forum.

The code below is used to create a backup copy of the current DB, in the current DB location. It works nicely and has the desired effect.



However, I'd like to have a Windows File SaveAs dialog browser open so that the user can select a location in to which they can save the copy of the DB. I'm happy to have the filename be predefined, as in the code below, but am open to the user being able to specify their own file name as well.

I've played around with various methods and functions, such as Application.FileDialog(msoFileDialogSaveAs), but can't seem to nail anything that works.

Any thoughts on how this could be achieved would be gratefully received.

Public Sub cmdBackupDB_Click()

Dim Source As String
Dim Target As String
Dim retval As Integer
Dim LResponse As Integer

Source = CurrentDb.Name
Target = CurrentProject.Path & "\Backup_" & Format(Date, "yy-mm-dd_") & Format(Time, "hhmmss_") & CurrentProject.Name

LResponse = MsgBox("Backup file will be named and written to;" & vbLf & vbLf & Target & vbLf & vbLf & "Do you wish to continue?", vbYesNo, "Continue with Backup?")

If LResponse = vbYes Then
    ' create the backup
    retval = 0
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    retval = objFSO.copyFile(Source, Target, True)
    Set objFSO = Nothing

Else
    Set objFSO = Nothing
    Exit Sub
End If

LResponse = MsgBox("Backup file successfully created." & vbLf & vbLf & Target & vbLf & vbLf & "Open folder location?", vbYesNo, "Open Backup Location?")
If LResponse = vbYes Then
    'Opens the folder of the file you just created
    Application.FollowHyperlink CurrentProject.Path
Else
    Exit Sub
End If
End Sub

[June7]

Consider this code that returns folder path as a string:

Dim sFolder As String
Dim fd As FileDialog
Dim booResult As Boolean
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.AllowMultiSelect = False
fd.Title = "Select database folder"
While booResult = False
    If fd.Show = True Then
        'folder path was selected
        booResult = True
        sFolder = fd.SelectedItems(1)
        Debug.Print sFolder
    End If
Wend

[sheusz]

Thank you June7. Works like a charm.

This is the new code with your solution implemented.

Public Sub cmdBackupDB_Click()
Dim stDocName As String
Dim sFolder As String
Dim fd As FileDialog
Dim booResult As Boolean
Dim Source As String
Dim Target As String
Dim retval As Integer
Dim LResponse As Integer

Source = CurrentDb.Name

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
fd.AllowMultiSelect = False
fd.Title = "Select folder to Backup Database"
While booResult = False
    If fd.Show = True Then
        'folder path was selected
        booResult = True
        sFolder = fd.SelectedItems(1)
        Target = sFolder & "\Backup_" & Format(Date, "yy-mm-dd_") & Format(Time, "hhmmss_") & CurrentProject.Name
        retval = 0
        Dim objFSO As Object
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        retval = objFSO.copyFile(Source, Target, True)
        Set objFSO = Nothing
        LResponse = MsgBox("Backup file successfully created." & vbLf & vbLf & Target & vbLf & vbLf & "Open folder location?", vbYesNo, "Open Backup Location?")
        If LResponse = vbYes Then
            'Opens the folder of the file you just created
            Application.FollowHyperlink sFolder
            Else
            Exit Sub
        End If
    Else
        Set objFSO = Nothing
        Exit Sub
    
    End If
Wend
End Sub