[Tasos]

Καλημέρα σε όλους!
Αλέξανδρε δοκίμασε:

Option Compare Database
Option Explicit
Private Const MyPC = 16& 'Αρχικός φάκελος του διαλόγου: Επιφάνεια εργασίας (Desktop)
Private Const ShOptions = 65&

Public Function FolderBrowserDialog() As String
    Dim oShell As Object
    Dim oFolder As Object
    Dim msg As Long
    msg = MsgBox("ΠΡΟΣΟΧΗ!!!!!   Πρόκειτε να κλείσετε την εφαρμογή." & vbLf & _
            "Για λόγους ασφαλείας προτείνεται η αντιγραφή" & "  των αρχείων της βάσης " & _
            vbCrLf & vbCrLf & "Nα γίνει αντιγραφή των αρχείων της βάσης?", _
            vbYesNoCancel, "ΠΡΟΕΙΔΟΠΟΙΗΣΗ ...")
    If msg = vbYes Then

        Set oShell = CreateObject("Shell.Application")
        Set oFolder = oShell.BrowseForFolder( _
                hWndAccessApp, "Επιλέξτε φάκελο για να δημιουργήσετε  αντίγραφο ασφαλείας." & vbLf & _
                "αυτής της εφαρμογής και πατήστε 'ΟΚ'." & vbLf & _
                "Πατήστε 'Ακυρο'για να κλείσετε την εφαρμογή χωρίς αντίγραφο ασφαλείας." _
                & vbLf, ShOptions, MyPC)
        If Not oFolder Is Nothing Then
            FolderBrowserDialog = oFolder.Self.Path
            Set oFolder = Nothing
            Set oShell = Nothing
        End If
    ElseIf msg = vbCancel Then
        FolderBrowserDialog = ":"
    End If

End Function

Private Sub Form_Unload(Cancel As Integer)
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim BackupFolder As String
    Dim SourcePath As String
    Dim DestintionPath As String
StartHere:
    BackupFolder = FolderBrowserDialog
    If BackupFolder = ":" Then
        Cancel = True
        Exit Sub
    End If
    If BackupFolder <> vbNullString Then
        If Right(BackupFolder, 1) <> "\" Then BackupFolder = BackupFolder & "\"
        SourcePath = CurrentProject.FullName
        DestintionPath = BackupFolder & Right(SourcePath, InStr(1, StrReverse(SourcePath), "\") - 1)
        If SourcePath <> DestintionPath Then
            FSO.CopyFile SourcePath, DestintionPath, True
        Else
            MsgBox "Δεν μπορείτε να αποθηκεύσετε αντίγραφο ασφαλείας " & _
                    "στον φάκελο που βρίσκεται η εφαρμογή!" & vbLf & _
                    "Επιλέξτε άλλη διαδρομή ή δημιουργήστε νέο φάκελο.", vbExclamation
            DestintionPath = vbNullString
            BackupFolder = vbNullString
            GoTo StartHere
        End If
    End If

End Sub

Τάσος