AccessTr.neT

Tam Versiyon: Bölünmüş Dosyanın Yedeğini Aldırmak.
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
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:

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
(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.