Macro'yla Excel Dosyası Yedekleme

Aşağıdaki prosedür, sırasıyla D, E, C disklerinin varlığını kontrol ediyor. Öncelikle hangisi varsa o diske yedekleme yapıyor. Yedekleme dosyası adını, Tarih ve Saati kullanarak oluşturuyor. Buradaki örneğimizde prosedürün çalışmasını bir düğmeye bağlı yapıyoruz. Başka türlü de bu prosedür çalıştırılabilir. 

------------------------------------------------------------------------------------------------------------------------

Option Explicit
Sub ExcelDosyasiniYedekle()
    Dim Disk, Dosya, Uzanti, YedekDosyaAdi, KayitYeri, Yer As String, i As Integer
    Dim DosyaSistemi As Object
    
    Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
    If DosyaSistemi.DriveExists("D:\") = True Then
     Disk = "D"
    Else
     If DosyaSistemi.DriveExists("E:\") = True Then
      Disk = "E"
     Else
      If DosyaSistemi.DriveExists("C:\") = True Then
       Disk = "C"
      End If
     End If
    End If
    Yer = Disk & ":\Yedekler\"
    
    For i = 1 To Len(ThisWorkbook.Name)
     If Mid(ThisWorkbook.Name, i, 1) = "." Then
      Dosya = Mid(ThisWorkbook.Name, 1, i - 1)
      Uzanti = Mid(ThisWorkbook.Name, i, Len(ThisWorkbook.Name))
     End If
    Next i 
  
    Application.DisplayAlerts = False
    YedekDosyaAdi = Dosya & Format(Now, " dd_mm_yyyy_hh_mm") & Uzanti
    KayitYeri = Yer & YedekDosyaAdi
    On Error Resume Next
    If Dir(Yer) = "" Then MkDir Yer
    On Error Resume Next
    DosyaSistemi.CopyFile ThisWorkbook.FullName, KayitYeri
    MsgBox "Yedekledim."
    ActiveWorkbook.Password = ""
    Application.DisplayAlerts = True
End Sub

------------------------------------------------------------------------------------------------------------------------