Private Sub yedekleme_Click()
'BackUp access komprimieren 1. Teil
Const BackUpFile    As String = "F:\BackUp.accdb"
Const tmpBackUpFile As String = "F:\tmpBackUp.accdb"
 
WinRARX$ = Environ$("ProgramFiles") & "\WinRAR\rar.exe"
 
    '// Yedekleme proseduru..
    Yedek_Proc CurrentProject.FullName, BackUpFile
 
    '// Veritabani sikistirma ve onarma.. _
        Ver. 2000 - 2002 - 2003 için !!!
    DBEngine.CompactDatabase _
            BackUpFile, tmpBackUpFile
 
    '// Ilk yedegi sil..
    Kill BackUpFile
 
    '// Sikistirma islemi için geçici dosyanin _
        adina orjinal ismini ver..
    While Dir(tmpBackUpFile) = ""
        DoEvents
    Wend
'
    Name tmpBackUpFile As BackUpFile
 
    '// WinRAR ile sikistirma...
    Shell WinRARX & _
        " M -ep " & Chr(34) & Left$(BackUpFile, Len(BackUpFile) - 4) & ".rar" & _
                Chr(34) & " " & Chr(34) & BackUpFile & Chr(34)
    MsgBox "Yedekleme islemi tamamlandi.", vbInformation
End Sub
Sub Yedek_Proc(Kaynak_Dosya As String, Hedef_Dosya As String)
'BackUp access komprimieren 2. Teil
On Error GoTo Hata
 '// 10485760 Byte = 10 MB
Dim s(10485760) As Byte, X As Long
Dim T() As Byte, i As Integer
 
    Open Kaynak_Dosya For Binary Access Read As #1
    Open Hedef_Dosya For Binary Access Write As #2
 
    '// Döngünün kaç kez çalismasi gerektigini _
        toplam dosya boyutunun 10 MB ile bölümün _
        tamsayi degeri ile buluruz.
    For i = 1 To Int(LOF(1) / 10485760)
        Get #1, , s
        Put #2, , s
    Next
 
    Erase s
 
    '// Eger kalan Byte 10 MB dan küçükse _
        kalan Byte asagidaki yapi ile eklenir.
    X = LOF(1) - LOF(2)
    If X > 0 Then
        ReDim T(X) As Byte
        Get #1, , T
        Put #2, , T
        Erase T
    End If
 
Cikis:
    Close #1
    Close #2
 
  Exit Sub
 
Hata: MsgBox "Hata olustu." & Chr(10) & Err.Description
    GoTo Cikis
End Sub