yedek alma

[mcetinkaya65]

Bir excel dosyasından ara ara belirli zaman aralığında, başka bir hdd in içine, başka bir klasör içine,otamatik yedek alması mümkün mü?
saygılarımla.

 

[İhsan Tank]

bu yapılabilir ama kod devamlı çalışacağı için tavsiye etmem açıkçası

 

[leumruk]

Merhaba,
Yakınlarda Dış Veri Al yöntemi ile kod çalıştırmaya yönelik bir çalışmam olmuştu. O çalışmayı sizin isteğinize uyarladım. Hem böylelikle verimliliğini denemiş oluruz. Ayrıca İhsan Bey'in bahsettiği kodun sürekli çalışması sorunu bu yöntemle aşılmış oluyor.
NOT: Bu kodlamada dakika aralıklı süre belirleyebiliyoruz. Saniye hesabı yok. Kırmızı ile belirttiğim kısım süre ayarı. Ben bir dakikaya ayarladım, siz isteğinize göre düzenlersiniz.

Private Sub Workbook_Open()
On Error GoTo son:
Application.ScreenUpdating = False
Set Aktif_Sayfa = ActiveSheet
Sheets("İslem_Sayfasi").Select
Application.EnableEvents = False
Sheets("İslem_Sayfasi").Columns(1).Delete
yol = ThisWorkbook.Path & "\" & ThisWorkbook.Name
adres = "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & yol
    With ActiveSheet.QueryTables.Add(Connection:=Array(adres _
        , ";Mode=Share Deny Write;Extended Properties=""HDR=NO;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database" _
        , "Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk" _
        , "Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet" _
        , "OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" _
        ), Destination:=Range("A1"))
        .CommandType = xlCmdTable
        .CommandText = Array("İslem_Sayfasi$")
        .RefreshPeriod = [COLOR="DarkRed"][B]1[/B][/COLOR]
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With
son:
Aktif_Sayfa.Select
Application.EnableEvents = True
End Sub

İşlemin gerçekleştiğini görebilmeniz için bir msgbox ekledim. Denemelerinizden sonra bunu silebilirsiniz. yol tanımını kendinize uyarlayın.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a1]) Is Nothing Then Exit Sub
[İslem_Sayfasi!a2].Clear
yol = "C:\"
ThisWorkbook.Save
ThisWorkbook.SaveCopyAs yol & "yedek.xls"
[COLOR="Blue"][B]MsgBox "çalıştı"[/B][/COLOR]
End Sub