Otomatik kaydet ve yedek al.

[sward175]

Masa Üstünde : "Ambarlı Balıkçı Barınağı - Aidat Takip" adında Bir klasör var.
Bu klasör içinde "Yedekler" diye bir klasör bulunuyor.
ve bu klasör içinde :"Ambarlı Balıkçı Barınağı Yıllık Aidat Takip 2025" adında bir dosya bulunuyor.
Bu dosyayı her kapattığımda hem kaydetsin hem de "Yedekler" klasörüne yedek alsın.
Bu kod için yardımlarınızı rica ederim.
Saygılarımla,
sward175

 

[pitchoute]

Merhaba, deneyip sonucu paylaşabilir misiniz;

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim YedekDosyaAdi As String
    Dim AnaDosyaYolu As String
    Dim YedekKlasorYolu As String
    
    If Not ThisWorkbook.Saved Then
        ThisWorkbook.Save
    End If
    AnaDosyaYolu = ThisWorkbook.Path
    YedekKlasorYolu = "C:\Users\" & Environ("username") & "\Desktop\Ambarlı Balıkçı Barınağı - Aidat Takip\Yedekler\"
    YedekDosyaAdi = "Ambarlı Balıkçı Barınağı Yıllık Aidat Takip 2025" & " - Yedek " & Format(Now(), "yyyy-mm-dd hh-nn-ss") & ".xlsx"
    
    On Error Resume Next
    ThisWorkbook.SaveCopyAs YedekKlasorYolu & YedekDosyaAdi
    On Error GoTo 0
End Sub

 

[sward175]

Merhaba: pitchoute,
Dosyada çalışıp çıkmak istediğimde kaydet diye soracak mı? soruyor kaydet diyorum. Kapatıp tekrar girip bakıyorum Yedek almıyor.
Hoşça Kalın,

 

[volki_112]

Masa Üstünde : "Ambarlı Balıkçı Barınağı - Aidat Takip" adında Bir klasör var.
Bu klasör içinde "Yedekler" diye bir klasör bulunuyor.
ve bu klasör içinde :"Ambarlı Balıkçı Barınağı Yıllık Aidat Takip 2025" adında bir dosya bulunuyor.
Bu dosyayı her kapattığımda hem kaydetsin hem de "Yedekler" klasörüne yedek alsın.
Bu kod için yardımlarınızı rica ederim.
Saygılarımla,
sward175

deneyiniz

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim dosyaYolu As String
    Dim yedekYolu As String
    Dim yedekDosyaAdi As String
    Dim tarihSaat As String
    Dim fso As Object
    
    ' Aktif dosyanın yolunu al
    dosyaYolu = ActiveWorkbook.Path
    
    ' Yedekleme için yeni dosya yolunu oluştur (Yedekler klasörü)
    yedekYolu = dosyaYolu & "\Yedekler\"
    
    ' FileSystemObject oluştur
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' Yedekler klasörünün varlığını kontrol et, yoksa oluştur
    If Not fso.FolderExists(yedekYolu) Then
        fso.CreateFolder yedekYolu
    End If
    
    ' Tarih ve saat bilgisini al (gün/ay/yıl saat'dakika'saniye formatında)
    tarihSaat = Format(Now, "dd.mm.yyyy   hh'mm'ss")
    
    ' Yedek dosyasının adını oluştur
    yedekDosyaAdi = "Ambarlı Balıkçı Barınağı Yıllık Aidat Takip " & tarihSaat & ".xlsm"

    ' Yedek dosyasını oluştur
    ThisWorkbook.SaveCopyAs yedekYolu & yedekDosyaAdi

    ' Dosyayı kaydet
    ThisWorkbook.Save 
    
    ' Dosyanın kapatılmasını engelleme
    Cancel = False
End Sub

 

[sward175]

Merhaba: volki_112
Kod uyguladım. Kaydet diye soruyor kaydet diyorum Fakat aynı Klasör içindeki Yedekler klasörüne kaydetmiyor.
Dilerseniz klasörü yükleyebilirim.
Kolaylıklar dilerim.

 

[sward175]

Sayın: volki_112 ,
Klasör Ektedir.

 

[volki_112]

Merhaba: volki_112
Kod uyguladım. Kaydet diye soruyor kaydet diyorum Fakat aynı Klasör içindeki Yedekler klasörüne kaydetmiyor.
Dilerseniz klasörü yükleyebilirim.
Kolaylıklar dilerim.

Bunu deneyiniz.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call Yedekle
    ' Dosyayı kaydet
    ThisWorkbook.Save
    
    ' Dosyanın kapatılmasını engelleme
    Cancel = False
End Sub

Sub Yedekle()
    
    Dim dosyaYolu As String
    Dim KlasorAdi As String
    Dim Tarih As String
    
    dosyaYolu = ThisWorkbook.Path ' Aktif Excel dosyasının kaydedildiği yolu alın
    
    KlasorAdi = "Yedek" ' Kontrol edilecek klasör adını belirleyin
    
    If Len(Dir(dosyaYolu & "\" & KlasorAdi, vbDirectory)) = 0 Then ' Klasörün varlığını kontrol edin
    
        ' Klasör yoksa oluşturun
    MkDir dosyaYolu & "\" & KlasorAdi
    MsgBox "Veri yedekleme bu Excel dosyasının olduğu klasöre yapılmaktadır. Excel 'in olduğu klasöre " & KlasorAdi & " isimli yeni bir klasör oluşturulup verileriniz bu klasörün içine yedeklenecektir.", vbInformation, "Bilgilendirme"
    Else
    End If
    
    Tarih = Format(Now, "dd.mm.yyyy   hh'mm'ss") ' Tarih bilgisini alın
    
        ' Yedek dosyasını kaydedin
    ThisWorkbook.SaveCopyAs dosyaYolu & "\" & KlasorAdi & "\Yedek Veri   " & Tarih & ".xlsb"
        
    MsgBox "Dosyanız TARİH ve SAAT Bilgisi" & vbCrLf & vbCrLf & "Eklenerek " & KlasorAdi & " Klasörüne Yedeklendi", vbInformation, "İşlem Sonucu"
        
End Sub

 

[volki_112]

Sayın: volki_112 ,
Klasör Ektedir.

kodu yanlış yere yazmışsınız. Workbook before Close kodu module e yazılmaz. Aşağıdaki dosyayı direkt indirip kullanın. Yedekler klasörü yoksa klasör oluşturup yedek alır. Klasör varsa klasör oluşturmadan direkt içine yedek alır. dosyada çıkış yani çarpıya basmanız yeterldiir.

 

[sward175]

Sayın: vÇok teşekkür ederim.

 

[volki_112]

Sayın: vÇok teşekkür ederim.

her çarpıya basınca yedek alır. Yedek aldım diye mesaj gösterir. İsterseniz mesaj göstermesini kaldırabilirsiniz.