Kod:
Function yedekal()
'Mehmet ESER 29.03.2012 01:22 Perşembe
'avt açıkken yedeklemey yapmaya yarar.
' 'Microsoft Scripting Runtime' referansını eklemelisiniz.
' <a href="http://www.eserbilisim.name.tr" target="_blank">http://www.eserbilisim.name.tr</a>
' <a href="http://access - sql.com" target="_blank">http://access - sql.com</a> da yayınlanmıştır.
' Berkant Öztürk, Adnan Yurdakul ve Zeki Gürsoy'a teşekürler.
'Güncel 7-zip kullanılmıştır. iso, 7z vb uzantılar mevcuttur.
'Komutlar için yardım dosyasına bakınız. winrar gibi uygulamara da uyarlanabilir.
'Uyarıları kaldırınız. Deneme amaçlı konulmuştur.
'Her şeyi ve mantığı Türkçe'dir. El emeği göz nurudur.:-)//
'Hata durumunda [email protected] bildiriniz.
Dim YedekAdi As String
YedekAdi = Format(Date, "(dd.mm.yyyy)") & "_" & Format(Time, "(hh.mm)") & "_" & CurrentProject.Name
If Len(Dir(CurrentProject.Path & "\Yedek", vbDirectory)) = 0 Then
MkDir CurrentProject.Path & "\Yedek"
End If
Dim fso As FileSystemObject
Set fso = New FileSystemObject
fso.CopyFile CurrentProject.FullName, CurrentProject.Path & "\Yedek\" & YedekAdi, True
Set fso = Nothing
Dim komut As String
Dim zipci As String
Dim kaynak As String
Dim hedef As String
'zipci = CurrentProject.Path & "\Yedek\7za.exe"
'zipci = Replace("""%1""", "%1", zipci)
'hedef = CurrentProject.Path & "\Yedek\" & YedekAdi & ".zip"
'hedef = Replace("""%1""", "%1", hedef)
'kaynak = CurrentProject.Path & "\Yedek\" & YedekAdi
'kaynak = Replace("""%1""", "%1", kaynak)
'komut = zipci & " a " & hedef & " " & kaynak
'Replace(YedekAdi, ".accdb", "")
zipci = "C:\Program Files\7-Zip\7z.exe"
hedef = CurrentProject.Path & "\Yedek\" & Replace(YedekAdi, ".accdb", "") & ".7z"
kaynak = CurrentProject.Path & "\Yedek\" & YedekAdi
Dim T
T = Chr(34) ' çift tırnak
komut = T & zipci & T & " a " & T & hedef & T & " " & T & kaynak & T
Debug.Print komut
Call Shell(komut)
Beep
MsgBox "Yedekleme İşlemi Yapıldı" & Chr(13) & Replace(YedekAdi, ".accdb", "") + ".7z", vbInformation, "Yedekleme Bilgisi:"
Dim silbunu As String
silbunu = CurrentProject.Path + "\Yedek\" & YedekAdi
Dim fsot As New FileSystemObject
fsot.DeleteFile (silbunu)
Set fsot = Nothing