Merhaba arkadaşlar. Bir uygulama hazırladım ve bu uygulamamı ağ üzerinden farklı kullanıcıların kullanabilmesi için tabloları böldüm. Program içerisinde buton aracılığı ile yedek aldırma işlemi yaptırıyorum, ama bu yedek alma işlemi sorgular, formlar, raporlar, modüller bulunan kısmının yedeğini alıyor, veri tabanının yani tabloların bulunduğu bölünmüş dosyanın yedeğini almıyor. Tabloların da bulunduğu bölünmüş Access nesnesinin yedeğini de aynı buton aracılığı ile aldırabilir miyim?

Bu konuda bir örnek uygulama ekliyorum. Yardımcı olacak arkadaşlara peşinen teşekkürler ediyor, saygılar sunuyorum.

Bir buton ekleyip aşağıdaki kodları butonun tıklanma olayına ekleyin:

(01/12/2014, 16:47)alpeki99 yazdı: Bir buton ekleyip aşağıdaki kodları butonun tıklanma olayına ekleyin:

Kod:

On Error GoTo HataYakala
Dim fs As Object
Dim tabloDosyasi As String
 
 tabloDosyasi = CurrentProject.Path & "\tablolar\ornek_be.accdb"
 Set fs = CreateObject("Scripting.FileSystemObject")
 fs.CopyFile tabloDosyasi, CurrentProject.Path & "\tablolar\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

çok teşekkür ediyorum, hemen deniyorum. peki şöyle yapamazmıyız, yedek alacağı yeri sorduramazmıyız, kod içerisinde path yani yol göstermek yerine, butona kliklediğimiz zaman, yedeğin nereye alınacağını bize nasıl sordurabilirim.

Bu arada gerçekten ilgi ve alakanıza canı gönülden teşekkürlerimi bildiriyorum.

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

(01/12/2014, 21:34)ozanakkaya yazdı: 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

Ozan kardeş, eline gönlüne sağlık. ALLAH RAZI OLSUN meslektaşım. harika oldu.

(01/12/2014, 21:34)ozanakkaya yazdı: 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

üstteki kodlarda 9. satırdaki ;

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

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

dosyası olarak nasıl derleyebilirim.   yani uzantı accdb veya accde, hangisi varsa onu yedeklesin. Bu konuda yardım talep ediyorum arkadaşlar. sağolun varolun.