Yedekleme butonunun kodlarını aşağıdaki ile değiştir.

On Error GoTo HataYakala



Dim fs As Object







Dim tabloDosyasi, YedekYeri As String

 YedekYeri = KlasorBul("Lütfen Uygulamanın Yedekleneceği Klasörü Seçiniz.")

 tabloDosyasi = CurrentProject.Path & "\tablolar\ornek_be.accdb"

 Set fs = CreateObject("Scripting.FileSystemObject")

 

 

 fs.CopyFile tabloDosyasi, YedekYeri & "\yedek" & Date & ".accdb"

 Set fs = Nothing

 MsgBox "Dosyanın yedeği alındı.", vbInformation, "İşlem Tamam"



HataCikis:

 Exit Sub

 

HataYakala:

 MsgBox "HATA : " & vbrlf & vbrlf & err.Description

End Sub

YEDEKLE isimli modülün en üstüne aşağıdaki kodları ekle

Option Compare Database



Option Explicit



Private Type BROWSEINFO

   hOwner As Long

   pidlRoot As Long

   pszDisplayName As String

   lpszTitle As String

   ulFlags As Long

   lpfn As Long

   lParam As Long

   iImage As Long

End Type

Private Const BIF_RETURNONLYFSDIRS = &H1

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

Public Function KlasorBul(szDialogTitle As String) As String

On Error GoTo Err_KlasorBul

   Dim X As Long, bi As BROWSEINFO, dwIList As Long

   Dim szPath As String, wPos As Integer

   With bi

       .hOwner = hWndAccessApp

       .lpszTitle = szDialogTitle

       .ulFlags = BIF_RETURNONLYFSDIRS

   End With

   dwIList = SHBrowseForFolder(bi)

   szPath = Space$(512)

   X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

   If X Then

       wPos = InStr(szPath, Chr(0))

       KlasorBul = Left$(szPath, wPos - 1)

   Else

       KlasorBul = ""

   End If

Exit_KlasorBul:

   Exit Function

Err_KlasorBul:

   MsgBox err.Number & " - " & err.Description

   Resume Exit_KlasorBul

End Function