Yedekleme

[ormann]

aşağıdaki yedekleme makrosunu kendi dosyama uyarlamaya çalıştım.Fakat Hata verdi.Yardımcı olurmusunuz.?

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
If MsgBox("Yedek alınacak onaylıyor musunuz ?", vbCritical + vbYesNo, "Mustafa MUTLU") = vbYes Then
Dim Yedek As String
Trh = Replace(Now, ":", "_")
Kyt = "c:\YEDEKLER\"
ThisWorkbook.Save
ds.CopyFile ThisWorkbook.FullName, Kyt & Trh & ".xls"
MsgBox "Yedek alma işlemi tamamlanmıştır.", vbInformation, "Mustafa MUTLU"
Else
MsgBox "Yedek alma işlemi iptal edilmiştir.", vbInformation, "Mustafa MUTLU"
End If
End Sub

 

[programer]

"C" sürücüsü altında "YEDEKLER" diye bir klasörünüz olmalı yoksa ondan hata veriyodur.

 

[ormann]

Yedekler diye bir klasör açtım.Fakat yine aynı hatayı veriyor

 

[halit3]

aşağıdaki yedekleme makrosunu kendi dosyama uyarlamaya çalıştım.Fakat Hata verdi.Yardımcı olurmusunuz.?

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
If MsgBox("Yedek alınacak onaylıyor musunuz ?", vbCritical + vbYesNo, "Mustafa MUTLU") = vbYes Then
Dim Yedek As String
Trh = Replace(Now, ":", "_")
Kyt = "c:\YEDEKLER\"
ThisWorkbook.Save
ds.CopyFile ThisWorkbook.FullName, Kyt & Trh & ".xls"
MsgBox "Yedek alma işlemi tamamlanmıştır.", vbInformation, "Mustafa MUTLU"
Else
MsgBox "Yedek alma işlemi iptal edilmiştir.", vbInformation, "Mustafa MUTLU"
End If
End Sub

kod:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
Dosya = ThisWorkbook.Name
uzanti = Right(Dosya, InStr(1, StrReverse(Dosya), ".", vbTextCompare))
If MsgBox("Yedek alınacak onaylıyor musunuz ?", vbCritical + vbYesNo, "Mustafa MUTLU") = vbYes Then
Dim Yedek As String
Trh = Format(Now, "dd.mm.yyyy hh_nn_ss")
Kyt = "c:\YEDEKLER\"
ThisWorkbook.Save
ds.CopyFile ThisWorkbook.FullName, Kyt & Trh & uzanti
MsgBox "Yedek alma işlemi tamamlanmıştır.", vbInformation, "Mustafa MUTLU"
Else
MsgBox "Yedek alma işlemi iptal edilmiştir.", vbInformation, "Mustafa MUTLU"
End If
End Sub

 

[ormann]

Sayın Halit bey yine aynı yerde hata verdi

 

[programer]

Ben çalıştırdım kodları gayet güzel çalışıyor. "C" deki "YEDEKLER" kalasörünü yazdığım gibi açın büyük küçük harften belki sıkıntı yapabilir

 

[ormann]

Ben ne yaptımsa çalıştıramadım

 

[programer]

Aşağıda daha önce arşive aldığım bir kod var kendinize uyarlamaya çalışın.

Private Sub CommandButton2_Click()

If MsgBox("Yedekleme İşlemi Başlatılsın mı?", vbInformation + vbYesNo, "Bilgi Mesajı") = vbNo Then
Exit Sub
End If


Dim Klasör As Object, Dizin As String, DosyaAdı As Variant
Set Klasör = CreateObject("Shell.Application").BrowseForFoldeR( 0, "Dosyanın yedekleneceği Klasörü seçin !", 1)

If Klasör Is Nothing Then
MsgBox "İşleme devam edebilmek için lütfen Klasör seçiniz !", vbExclamation, "Dikkat !"
Exit Sub
End If
Application.ScreenUpdating = False

DosyaAdı = Range("K4").Text
Dizin = Klasör.Self.Path & "\" & DosyaAdı & ".xls"

Sheets(Array("kasa_banka")).Select
Sheets(Array("kasa_banka")).Copy
ActiveWorkbook.SaveAs Filename:=Dizin
ActiveWindow.Close

Application.ScreenUpdating = True
MsgBox "İşlem Tamam... Bu güzel raporunuz kopyalanmıştır.", vbInformation


End Sub




Thisworkbook modulundede Before Close olayına aşağıdaki kodu yazın

Kod:
If Module1.kayit = False Then Cancel = True

 

[halit3]

Sayın Halit bey yine aynı yerde hata verdi

Birde bunu dene olmazsa hata ekranını ekle bir bakalım.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
Kyt = "c:\YEDEKLER"
On Error Resume Next
If Dir(Kyt) = "" Then MkDir Kyt
Dosya = ThisWorkbook.Name
uzanti = Right(Dosya, InStr(1, StrReverse(Dosya), ".", vbTextCompare))
If MsgBox("Yedek alınacak onaylıyor musunuz ?", vbCritical + vbYesNo, "Mustafa MUTLU") = vbYes Then
Dim Yedek As String
Trh = Format(Now, "dd.mm.yyyy hh_nn_ss")
ThisWorkbook.Save
ds.CopyFile ThisWorkbook.FullName, Kyt & "\" & Trh & uzanti
MsgBox "Yedek alma işlemi tamamlanmıştır.", vbInformation, "Mustafa MUTLU"
Else
MsgBox "Yedek alma işlemi iptal edilmiştir.", vbInformation, "Mustafa MUTLU"
End If
End Sub

 

[Murat OSMA]

Alternatif:

Sub Yedek()
    Dim Dosyaadi As String, Klasor As String
    Dosyaadi = ActiveWorkbook.Name
    Klasor = ThisWorkbook.Path & "\Yedek\"
    
    If MsgBox("Yedek alınacak onaylıyor musunuz ?", _
        vbInformation + vbMsgBoxRtlReading + vbYesNo, Application.UserName) = vbYes Then
    
    If Dir(Klasor) = "" Then MkDir Klasor
        
        ActiveWorkbook.SaveCopyAs Klasor & Dosyaadi
        ActiveWorkbook.Save
        MsgBox " ..::.. Çalışma kitabınız" & Chr(10) & "Yedek klasörüne kaydedildi ..::.. " _
        , vbInformation + vbMsgBoxRtlReading, Application.UserName
    Else
    Exit Sub
    End If
    Klasor = vbNullString: Dosyaadi = vbNullString
End Sub

 

[halit3]

Ben ne yaptımsa çalıştıramadım

Geri dönüş yapılmadığı için yazıyorum burada üç kişi çözüm sunmuş kodlar acaba çalışmadımı.?

 

[ormann]

Özür dilerim Halit bey.Unuttum cevap yazmaya kusura bakmayın. kodlar gayet güzel çalışıyor.