Yedeklemede yardım

[power468]

Aşağıdaki kodla yedeği masaüstüne deyilde Yerel disk D: ye nasıl yedek almasını sağlarız.


Sub YedekAlma()
Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
yer = Environ("USERPROFILE") & "\DESKTOP\YEDEK"
If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If
If ThisWorkbook.Path = yer Then Exit Sub
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "DURUM") = vbNo Then
MsgBox "İptal ettiniz.", vbInformation
Exit Sub
End If
dosyaadi = ThisWorkbook.FullName
uzanti = "." & ds.GetExtensionName(dosyaadi)
yol = yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & uzanti
ds.CopyFile dosyaadi, yol
End Sub

 

[askm]

Sub YedekAlma()
Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
'yer = Environ("USERPROFILE") & "\DESKTOP\YEDEK"
yer = "D:\"
If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If
If ThisWorkbook.Path = yer Then Exit Sub
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "DURUM") = vbNo Then
MsgBox "İptal ettiniz.", vbInformation
Exit Sub
End If
dosyaadi = ThisWorkbook.FullName
uzanti = "." & ds.GetExtensionName(dosyaadi)
yol = yer & Format(Now, " dd.mm.yyyy hh_nn_ss") & uzanti
ds.CopyFile dosyaadi, yol
End Sub

 

[Haluk]

@askm;

Kodun başında aşağıdaki gibi, diskte söz konusu bölümün ("D") var olup olmadığını kontrol etmek iyi olur...

    yer = "D:\"
    If Not ds.driveExists(Left(yer, 1)) Then
        MsgBox Left(yer, 1) & " - bolumu yok ...."
        Exit Sub
    End If

.

 

[askm]

Haluk Bey teşekkürler.