Dosya yedekleme

[TURKOLOG]

Sayın @Korhan Ayhan çok teşekkür ederim. Kodu deneyip size bilgi vereceğim. Elinize emeğinize sağlık.

 

[TURKOLOG]

Sayın @Korhan Ayhan çok teşekkür ederim kod çalışıyor.

 

[ASLAN7410]

Sayın Korhan Bey, yazmış olduğunuz kod gayet sadeleşmiş ellerinize sağlık, çok teşekkür ediyorum.

Göndermiş olduğunuz aşağıdaki kodda değişiklik yapmaya çalıştım, yapamadım.

Yapmak istediğim butona bastığımda Yedek1 klasörü içerisine aynı işlemi .xlsx uzantılı olarak kaydetsin.
Yardımcı olur musunuz?

Option Explicit
Sub Yedekle()
    Dim Yol As String, Sayfa As Worksheet
  
    'Yol = "D:\Yedek"
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Yedek1"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

    If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
        MsgBox "İşlemi iptal ettiniz!", vbExclamation
        Exit Sub
    End If
  
    ThisWorkbook.Save
    ThisWorkbook.SaveCopyAs Yol & "\" & Format(Now, "dd.mm.yyyy hh_nn_ss") & " " & ThisWorkbook.Name
  
    MsgBox "Dosya D:\Yedek klasörüne yedeklendi.", vbInformation
End Sub

 

[ASLAN7410]

Kod içine aşağıdaki kısmı eklemeye çalıştım olmadı.

ActiveWorkbook.SaveAs Yol & "\" & Format(Now, "dd.mm.yyyy hh_nn_ss") & " " & Replace(ThisWorkbook.Name, "xlsm", "xlsx"), 51
ActiveWorkbook.Close

 

[Korhan Ayhan]

@ASLAN7410,

#7 nolu mesakımdaki kod ile XLSX formatında yedek alabilirsiniz.

 

[ASLAN7410]

Gereksiz olduğu için silindi.

 

[ASLAN7410]

Aşağıdaki gibi yaptım, çalıştı, kodda fazlalık veya eksiklik varmı acaba?

Sub Yedekle1()
    Dim Yol As String, Sayfa As Worksheet
  
    'Yol = "D:\Yedek"
    Yol = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Yedek"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

    If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
        MsgBox "İşlemi iptal ettiniz!", vbExclamation
        Exit Sub
    End If
  
    ThisWorkbook.Save
        ActiveWorkbook.SaveAs Yol & "\" & Format(Now, "dd.mm.yyyy hh_nn_ss") & " " & Replace(ThisWorkbook.Name, "xlsm", "xlsx"), 51
    Application.DisplayAlerts = False
  
    MsgBox "Yedek klasörüne yedeklendi.", vbInformation
    Application.DisplayAlerts = True
End Sub

 

[Korhan Ayhan]

Sizin kullandığınız şekilde aktif (makrolu) dosya kapanmadı mı?

 

[ASLAN7410]

27.mesajımdaki kodu çalıştırdığım zaman, .xlsm dosyası kapandı, yedek klasörü içerisine de kapalı olarakta .xlsx dosyası şeklinde attı.

Bu şekilde tam istediğim gibi çalışıyor.

 

[ASLAN7410]

Sayın Korhan Bey, yeni fark ettim Yedek klasörü içerisinde ekte gönderdiğim resimdeki gibi kaydediyor.

 

[Korhan Ayhan]

Dediğim gibi #7 nolu mesajımdaki kod sorunsuz çalışıyor. Onu kullanın.

 

[FURKAN6@6]

@Korhan Ayhan hocam bu kodu
1. Yeni klasör isminde değilde bir sonraki günün tarihinin ismi ile nasıl oluşturan biliriz
2. Oluşturduğumuz bu klasöre sadece benim belirlediğim (örnek sayfa1, sayfa2) gibi sayfa toplu alarak nasıl kaydederim teşekkürler

 

[ASLAN7410]

Sayın Korhan Bey, ilginiz için çok teşekkür ediyorum.
#7 nolu mesajınızdaki kod gayet güzel çalışıyor ellerizine sağlık. Küçük bir istekte bulunmak istiyorum.

Butona bastığımda .xlsm uzantılı dosyayı YEDEK klasörüne, .xlsx uzantılı dosyayıda YEDEK-1 klasörüne aktarabilir misiniz?
Yani dosyaları ayrı ayrı klasörlerde yedeklese, bu şekilde de yapabilir misiniz?

 

[Korhan Ayhan]

Bu tarz değişiklikleri koda bakarak artık sizlerinde yapabiliyor olması gerekiyor.

Option Explicit

Sub Yedekle()
    Dim Yol_A As String, Yol_B As String, Sayfa As Worksheet
    
    Yol_A = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Yedek"
    If Dir(Yol_A, vbDirectory) = "" Then MkDir (Yol_A)

    Yol_B = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Yedek-1"
    If Dir(Yol_B, vbDirectory) = "" Then MkDir (Yol_B)

    If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
        MsgBox "İşlemi iptal ettiniz!", vbExclamation
        Exit Sub
    End If
    
    ThisWorkbook.Save
    ThisWorkbook.SaveCopyAs Yol_A & "\" & Format(Now, "dd.mm.yyyy hh_nn_ss") & " " & ThisWorkbook.Name
    
    ThisWorkbook.Sheets.Copy
    
    For Each Sayfa In ActiveWorkbook.Worksheets
        If Sayfa.DrawingObjects.Count > 0 Then
            Sayfa.DrawingObjects.Visible = True
            Sayfa.DrawingObjects.Delete
        End If
    Next
    
    ActiveWorkbook.SaveAs Yol_B & "\" & Format(Now, "dd.mm.yyyy hh_nn_ss") & " " & Replace(ThisWorkbook.Name, "xlsm", "xlsx"), 51
    ActiveWorkbook.Close
    
    MsgBox "Dosya masaüstündeki YEDEK ve YEDEK-1 klasörüne yedeklendi.", vbInformation
End Sub

 

[ASLAN7410]

Sayın Korhan Bey, tam istediğim gibi oldu Allah razı olsun, ellerinize sağlık çok teşekkür ediyorum.

Hayırlı akşamlar diliyorum.

 

[policeman]

Option Explicit

Sub Yedekle()
Dim Yol As String, Sayfa As Worksheet

Yol = "D:\Yedek"
If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
MsgBox "İşlemi iptal ettiniz!", vbExclamation
Exit Sub
End If

ThisWorkbook.Save
ThisWorkbook.SaveCopyAs Yol & "\" & Format(Now, "dd.mm.yyyy hh_nn_ss") & " " & ThisWorkbook.Name

MsgBox "Dosya D:\Yedek klasörüne yedeklendi.", vbInformation
End Sub

Merhaba..
Bu kodu kullanarak dosyamın yedeğini şu şekilde alıyorum; 09.04.2020 23_35_58 Ajanda
Ama benim istediğim bu şekilde olması; Ajanda 09.04.2020 23_35_58
Değişiklik yapmaya uğraştım ama hata verdi, yardımcı olurmusunuz?
Saygılarımla..

 

[policeman]

Yardımlarınızı bekliyorum..
Saygılarımla...

 

[Korhan Ayhan]

Deneyiniz.

ThisWorkbook.SaveCopyAs Yol & "\" & Replace(ThisWorkbook.Name, ".xlsm", " ") & Format(Now, "dd.mm.yyyy hh_nn_ss") & ".xlsm"

 

[policeman]

Sayın Korhan Ayhan böyle bir hata verdi .

 

[policeman]

Acaba excelimin 2003 türkçe oluşundan mı?