Dosyadan Çıkarken Otomatik Yedeklemek

[hakki83]

Merhabalar

Ekteki dosya çıkışta, günün tarihi ile birlikte xlsb olarak masaüstüne yedek oluşturmaktadır.

Şu üç değişikliği yapabilir miyiz,

--Xlsb değil, Xlsm olarak kaydetsin.
(FileFormat:=xlOpenXMLWorkbookMacroEnabled olarak denedim olmadı)

--Yedeklenen dosyayı masaüstüne değil, orjinal dosyanın bulunduğu konuma kaydetsin.

--Aynı gün içinde birden çok dosyadan çıkış yaptığımız için gün, ay, yıl, saat dakika saniye ile adlandırarak dosyalar oluştursun.

Teşekkürler

 

[RBozkurt]

Merhaba, deneyiniz.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim DosyaAdi As String
    DosyaAdi = Format(Now, "dd.mm.yyyy hh.mm.ss") & ".xlsm"
    ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & DosyaAdi, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

Aşağıdaki kod ile Aynı dizine Yedek klasörü oluşturulue ve kayıt yapılırken başına dosya adı gelir.
örnek dosya (11.03.2023 10.32.31)

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim DosyaAdi As String, YedekKlasoru As String, YedekDosyaAdi As String
    YedekKlasoru = ThisWorkbook.Path & "\Yedek\"
    If Len(Dir(YedekKlasoru, vbDirectory)) = 0 Then ' Yedek klasörü yoksa oluştur
        MkDir YedekKlasoru
    End If
    DosyaAdi = Replace(Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1), ".", "_")
    DosyaAdi = DosyaAdi & " (" & Format(Now(), "dd.mm.yyyy hh.mm.ss") & ")" & ".xlsm"
    YedekDosyaAdi = YedekKlasoru & DosyaAdi
    ThisWorkbook.SaveAs Filename:=YedekDosyaAdi, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

 

[hakki83]

RBozkurt hocam sağ olunuz. Emeklerinize sağlık.

 

[RBozkurt]

RBozkurt hocam sağ olunuz. Emeklerinize sağlık.

Rica ederim kolay gelsin.