• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

çalışma kitabını yedekleme

Emir Hüseyin Çoban

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,891
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
Merhaba Arkadaşlar,

İçerisinde veriler, makro kodları ve userform olan bir tablom var.
Bu tabloma içerisine bir buton ekleyip
C:\ nin içinde yedek klasörüne yedek_gün_ay_yıl_saat_dk kombinasyonuyla yedeklemesini istiyorum.

Forumda bulduğum kodlarda çalışma sayfalarını yedekleye bildim ama makrolar ve userformda hatalar verdi.

Farklı kaydet kodlarıyla yedeklemeye çalıştım. Ama farklı kaydettiği dosya üzerinden çalışmaya devam etti.

Çalışma kitabını kopya-yapıştır da olduğu gibi içerisindeki herşeyle yedeklememiz mümkün mü?

Yardım ve fikirlerinizi bekliyorum.
 
Selamlar,

Aşağıdaki kodlardan birisini kullanabilirsiniz.

1. Alternatif;

Kod: 
Option Explicit
 
Sub AKTİF_DOSYAYI_YEDEKLE()
    Dim DosyaSistemi As Object, Aktif_Dosya_Adı As String
    Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
 
    Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
    Aktif_Dosya_Adı = ThisWorkbook.FullName
    Yedek_Dosya_Adı = Replace(ThisWorkbook.Name, ".xls", "") & Format(Date, " dd_mm_yyyy") & "_" & Format(Now, "hh_mm") & ".xls"
 
    Kayıt_Yeri = "C:\YEDEK\" & Yedek_Dosya_Adı
 
    ThisWorkbook.Save
 
    On Error Resume Next
    If Dir("C:\YEDEK\") = "" Then MkDir "C:\YEDEK\"
    DosyaSistemi.CopyFile Aktif_Dosya_Adı, Kayıt_Yeri
 
    MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Kayıt_Yeri, vbInformation
End Sub


2. Alternatif;

Kod: 
Option Explicit
 
Sub AKTİF_DOSYAYI_YEDEKLE()
    Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
 
    Yedek_Dosya_Adı = Replace(ThisWorkbook.Name, ".xls", "") & Format(Date, " dd_mm_yyyy") & "_" & Format(Now, "hh_mm") & ".xls"
    Kayıt_Yeri = "C:\YEDEK\" & Yedek_Dosya_Adı
 
    If Dir("C:\YEDEK\") = "" Then MkDir "C:\YEDEK\"
 
    ThisWorkbook.SaveCopyAs Filename:=Kayıt_Yeri
 
    MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Kayıt_Yeri, vbInformation
End Sub
 
Teşekkürler Korhan Hocam, tablomdaki emeğiniz benden fazla.
İyi günler dilerim.
 
Verdiğiniz ilk kodları tabloma uygulattım ve sorunsuz çalışıyor Korhan Hocam,
İlk sorumda belirtmediğim ancak daha sonra fark ettiğim bir işlem var ve eklenirse daha iyi olacağını düşündüğüm bir işlem.
Yedeklenen dosyaya parola koymak için kodlara nasıl bir ekleme yapmalıyız.
 
Selamlar,

Bu durumda ikinci kodu kullanmanız gerekecektir. Kırmızı bölümlere parolanızı yazınız.

Kod: 
Option Explicit
 
Sub AKTİF_DOSYAYI_YEDEKLE()
    Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
 
    Yedek_Dosya_Adı = Replace(ThisWorkbook.Name, ".xls", "") & Format(Date, " dd_mm_yyyy") & "_" & Format(Now, "hh_mm") & ".xls"
    Kayıt_Yeri = "C:\YEDEK\" & Yedek_Dosya_Adı
 
    If Dir("C:\YEDEK\") = "" Then MkDir "C:\YEDEK\"
 
    ThisWorkbook.SaveCopyAs Filename:=Kayıt_Yeri, FileFormat:=xlNormal _
    , Password:="[COLOR=red][B]12345[/B][/COLOR]", WriteResPassword:="[COLOR=red][B]12345[/B][/COLOR]", ReadOnlyRecommended:=False, CreateBackup:=False
 
    MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Kayıt_Yeri, vbInformation
End Sub
 
Korhan Hocam,

2. yedekleme kodlarını parola ekleri olmadan tabloya uygulattım, ancak hata verdi ve
MkDir "C:\YEDEK\" kodunu sarı ile boyadı.

parola kodlarıyla beraber uygulattım ancak yine hata verdi.
 
Selamlar,

Şimdilik o satırın bir üstüne "On Error Resume Next" yazıp deneyiniz. Akşam evden hata kontrolü yapılmış kodu düzenleyip eklerim.
 
İlginiz için teşekkürler Korhan Hocam, iki kodu karşılaştırınca "On Error Resume Next" kodlarını fark ettim ve ekledim kodlara. Yedekleme kodları çalışıyor.

Ancak parolalı yedekleme kodlarına uygulatınca hala hata veriyor.

İyi Akşamlar.
 
ofis 2007 (FileFormat:=xlNormal ) galiba bu format çalışmıyor
bunun yerine (FileFormat:=xlExce8) bunu denermisiniz.
 
Kod: 
Option Explicit
 
Sub AKTİF_DOSYAYI_YEDEKLE()
    Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
 
    Yedek_Dosya_Adı = Replace(ThisWorkbook.Name, ".xls", "") & Format(Date, " dd_mm_yyyy") & "_" & Format(Now, "hh_mm") & ".xls"
    Kayıt_Yeri = "C:\YEDEK\" & Yedek_Dosya_Adı
 
    If Dir("C:\YEDEK\") = "" Then MkDir "C:\YEDEK\"
    [COLOR="Red"]ActiveWorkbook.SaveAs [/COLOR]Filename:=Kayıt_Yeri, FileFormat:=[COLOR="Red"]xlExcel8[/COLOR] _
   [COLOR="Red"] , Password:="12345"
    'WriteResPassword:="12345", ReadOnlyRecommended:=False, CreateBackup:=False[/COLOR]
 
    MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Kayıt_Yeri, vbInformation
End Sub

renkli satırlarda değişiklik yaptım. Parolalı yedekleme işlemi çalışıyor.
Sy Korhan Ayhan ve Halit3 ilgi ve yardımlarınız için teşekkür ederim.
İyi akşamlar dileri.
 
Son düzenleme:
Merhaba Arkadaşlar,

Kod: 
Option Explicit
 
Sub AKTİF_DOSYAYI_YEDEKLE()
    Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
 
    Yedek_Dosya_Adı = Replace(ThisWorkbook.Name, ".xls", "") & Format(Date, " dd_mm_yyyy") & "_" & Format(Now, "hh_mm") & ".xls"
    Kayıt_Yeri = "C:\YEDEK\" & Yedek_Dosya_Adı
 
    If Dir("C:\YEDEK\") = "" Then MkDir "C:\YEDEK\"
    ActiveWorkbook.SaveAs Filename:=Kayıt_Yeri, FileFormat:=xlExcel8 _
    , Password:="12345"
    'WriteResPassword:="12345", ReadOnlyRecommended:=False, CreateBackup:=False
 
    MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Kayıt_Yeri, vbInformation, "Ajandam Uyarı Sistemi"
End Sub

tablomu yedeklemek için bu kodları kullanıyorum
ancak yedekledikten sonra çalışmaya yedek aldığı dosya üzerinden devam ediyor.

tabloyu aktif olarak kullanmaya başlamadığım için fark edemedim bu durumu
yedekleme yaptıktan sonra aynı tablo üzerinde çalışmaya devam etmek için
kodlarla nasıl bir düzenleme yapmalıyım.
 
Son düzenleme:
bu kodu denermisiniz.

Sub AKTİF_DOSYAYI_YEDEKLE()
Kayıt_Yeri = "C:\YEDEK\"
On Error Resume Next
If Dir(Kayıt_Yeri) = "" Then MkDir Kayıt_Yeri
On Error Resume Next
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
With Destwb
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With
TempFilePath = Kayıt_Yeri 'Application.DefaultFilePath & "\"
TempFileName = Sourcewb.Name & " " & Format(Now, "dd_mm_yyyy_hh_mm_ss")
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum, Password:="358100"
.Close SaveChanges:=False
End With
MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & TempFileName, vbInformation, "Ajandam Uyarı Sistemi"
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Genişletmek için tıkla ...
 
Sy Halit3, kodları tabloma uygulattım.
Tablo içindeki bir butonla yedekleme işlemi yapacağım, sadece aktif olan sayfayı yedekliyor böyle olunca diğer sayfalar eksik kalıyor ve tablo içersindeki makrolar hata veriyor.

Yedeklediği dosya ismini Ajandam_2010.xls 04_11_2010_13_40_06 olarak atıyor.
.xls yazısı olmasa daha iyi olur.
 
birde bunu denermisiniz.
Sub AKTİF_DOSYAYI_YEDEKLE()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
ActiveWorkbook.Save
yer = ThisWorkbook.FullName
Application.DisplayAlerts = False
Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
Yedek_Dosya_Adı = Replace(ThisWorkbook.Name, ".xls", "") & Format(Date, " dd_mm_yyyy") & "_" & Format(Now, "hh_mm") & ".xls"
Kayıt_Yeri = "C:\YEDEK\" & Yedek_Dosya_Adı
On Error Resume Next
If Dir("C:\YEDEK\") = "" Then MkDir "C:\YEDEK\"
On Error Resume Next
ActiveWorkbook.SaveAs Filename:=Kayıt_Yeri, Password:="358100"
MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Kayıt_Yeri, vbInformation, "Ajandam Uyarı Sistemi"
yeni_dosya_adı = ActiveWorkbook.Name
Dim wb As Workbook
Set wb = Workbooks.Open(yer)
Windows(yeni_dosya_adı).Activate
ActiveWindow.Close
Application.DisplayAlerts = True
'WriteResPassword:="358100", ReadOnlyRecommended:=False, CreateBackup:=False

End Sub
Genişletmek için tıkla ...
 
Teşekkürler Halit Hocam, kodlar sorunsuz olarak istediğim yedekleme işlemini yapıyor
.
Ancak aklıma takılan birşeyi sormak istiyorum, sanırım yedekleme işlemini yaparken çalışmakta olan dosyada kapat aç benzeri bir işlem yaptırıyor. Her zaman olmasada Excel bir sorunla karşılaştı "veri kurtarma" "hata raporu gönderme" ekranına yönlendiriyor ve tabloyu kapatıyor.

Denemelerimde veri kaybı yaşatmadı ama düşük performansı bir pc de veri kaydı yaşata bilir.

Hata ekranına yönlendirmesini kodlardaki kapat aç benzeri birşeyden kaynaklandığını düşünüyorum.
 
evet dosyayı kapatıp açıyor diğer türlü Password:="358100" bu işlemi yaptıramıyoruz.
 
buda farklı bir kod

Sub AKTİF_DOSYAYI_YEDEKLE()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
ActiveWorkbook.Save
Application.DisplayAlerts = False
Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
Yedek_Dosya_Adı = Replace(ThisWorkbook.Name, ".xls", "") & Format(Date, " dd_mm_yyyy") & "_" & Format(Now, "hh_mm") & ".xls"
Kayıt_Yeri = "C:\YEDEK\" & Yedek_Dosya_Adı
On Error Resume Next
If Dir("C:\YEDEK\") = "" Then MkDir "C:\YEDEK\"
On Error Resume Next
DosyaSistemi.CopyFile ThisWorkbook.FullName, Kayıt_Yeri
MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Kayıt_Yeri, vbInformation, "Ajandam Uyarı Sistemi"
Application.DisplayAlerts = True
'WriteResPassword:="358100", ReadOnlyRecommended:=False, CreateBackup:=False
End Sub
Genişletmek için tıkla ...
 
tekrar tekrar teşekkürler Halit Hocam ve Korhan Hocam zahmetler verdim.

Halit Hocam bu kodlarıda ekleyerek parola kısmınıda hallettim.
Kod: 
ActiveWorkbook.Password = "358100"
ActiveWorkbook.Save


Parolamda deşifre oldu artık değiştireyim :D
 
kodun bu hali iyi oldu galiba

Sub AKTİF_DOSYAYI_YEDEKLE()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
yer = "C:\YEDEK\"
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
ActiveWorkbook.Password = "358100"
ActiveWorkbook.Save
Application.DisplayAlerts = False
Yedek_Dosya_Adı = Dosya & Format(Now, " dd_mm_yyyy_hh_mm") & uzanti
Kayıt_Yeri = yer & Yedek_Dosya_Adı
On Error Resume Next
If Dir(yer) = "" Then MkDir yer
On Error Resume Next
DosyaSistemi.CopyFile ThisWorkbook.FullName, Kayıt_Yeri
ActiveWorkbook.Password = ""
MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Kayıt_Yeri, vbInformation, "Ajandam Uyarı Sistemi"
Application.DisplayAlerts = True
End Sub
Genişletmek için tıkla ...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst