VBA Kod yardımı

[Mehmet Sait]

Merhabalar,

Ekli kod yardımı ile Excel çalışma sayfasının yedeğini alıyorum. Yedeği "C:\YEDEKLER" Klasörüne kaydediyor. İstediğim yedek alınan günü "C:\YEDEKLER\16.07.2021\" şeklinde klasör oluşturması mümkün mü ?

Sub yedekle()
    Dim FSO As Object, Yol As String, Klasor As Object
    Dim Dosya_Adi As String, Dosya As Object, Tarih As Date
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    ThisWorkbook.Save
    
    Yol = "C:\YEDEKLER"

    If FSO.FolderExists(Yol) = False Then
        FSO.CreateFolder Yol
    Else
        Set Klasor = FSO.GetFolder(Yol)
        
        For Each Dosya In Klasor.Files
            If Left(Dosya.Name, 1) <> "~" Then
                Tarih = Split(Dosya.Name, " ")(0)
                If Tarih < Date - 2 Then
                    Dosya.Delete
                End If
            End If
        Next
    End If
    
    If ThisWorkbook.Path = Yol Then Exit Sub
    
    If MsgBox("Dosyanın yedeğini almak istiyor musun?", vbInformation + vbYesNo, "DURUM") = vbYes Then
        Dosya_Adi = Yol & Application.PathSeparator & Replace(Now, ":", "_") & "-" & ThisWorkbook.Name
        FSO.CopyFile ThisWorkbook.FullName, Dosya_Adi
    End If

    Set Klasor = Nothing
    Set FSO = Nothing
End Sub

Yardımlarınız için teşekkür ederim.

 

[muratboz06]

Deneyiniz.

Sub yedekle()
    Dim FSO As Object, Yol As String, Klasor As Object
    Dim Dosya_Adi As String, Dosya As Object, Tarih As Date
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    ThisWorkbook.Save
    Call YedekKlasoruOlustur
    Yol = "C:\YEDEKLER\" & Format(Date, "dd.mm.yyyy") & "\"

    If FSO.FolderExists(Yol) = False Then
        FSO.CreateFolder Yol
    Else
        Set Klasor = FSO.GetFolder(Yol)
        
        For Each Dosya In Klasor.Files
            If Left(Dosya.Name, 1) <> "~" Then
                Tarih = Split(Dosya.Name, " ")(0)
                If Tarih < Date - 2 Then
                    Dosya.Delete
                End If
            End If
        Next
    End If
    
    If ThisWorkbook.Path = Yol Then Exit Sub
    
    If MsgBox("Dosyanın yedeğini almak istiyor musun?", vbInformation + vbYesNo, "DURUM") = vbYes Then
        Dosya_Adi = Yol & Application.PathSeparator & Replace(Now, ":", "_") & "-" & ThisWorkbook.Name
        FSO.CopyFile ThisWorkbook.FullName, Dosya_Adi
    End If

    Set Klasor = Nothing
    Set FSO = Nothing
End Sub

Public Sub YedekKlasoruOlustur()
    On Error GoTo Son
    MkDir ("C:\YEDEKLER\" & Format(Date, "dd.mm.yyyy"))
Son:

End Sub

 

[Necdet]

Merhaba,

Yol = "C:\YEDEKLER"

satırını aşağıdaki gibi değiştirin

Yol = "C:\YEDEKLER1\" & Date
MkDir Yol

 

[Mehmet Sait]

Deneyiniz.

Sub yedekle()
    Dim FSO As Object, Yol As String, Klasor As Object
    Dim Dosya_Adi As String, Dosya As Object, Tarih As Date
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    ThisWorkbook.Save
    Call YedekKlasoruOlustur
    Yol = "C:\YEDEKLER\" & Format(Date, "dd.mm.yyyy") & "\"

    If FSO.FolderExists(Yol) = False Then
        FSO.CreateFolder Yol
    Else
        Set Klasor = FSO.GetFolder(Yol)
       
        For Each Dosya In Klasor.Files
            If Left(Dosya.Name, 1) <> "~" Then
                Tarih = Split(Dosya.Name, " ")(0)
                If Tarih < Date - 2 Then
                    Dosya.Delete
                End If
            End If
        Next
    End If
   
    If ThisWorkbook.Path = Yol Then Exit Sub
   
    If MsgBox("Dosyanın yedeğini almak istiyor musun?", vbInformation + vbYesNo, "DURUM") = vbYes Then
        Dosya_Adi = Yol & Application.PathSeparator & Replace(Now, ":", "_") & "-" & ThisWorkbook.Name
        FSO.CopyFile ThisWorkbook.FullName, Dosya_Adi
    End If

    Set Klasor = Nothing
    Set FSO = Nothing
End Sub

Public Sub YedekKlasoruOlustur()
    On Error GoTo Son
    MkDir ("C:\YEDEKLER\" & Format(Date, "dd.mm.yyyy"))
Son:

End Sub

Emeğinize sağlık, teşekkür ederim.

 

[Mehmet Sait]

Merhaba,

Yol = "C:\YEDEKLER"

satırını aşağıdaki gibi değiştirin

Yol = "C:\YEDEKLER1\" & Date
MkDir Yol

Emeğinize sağlık, teşekkür ederim.