Yedeklemede yardım

Katılım
23 Aralık 2017
Mesajlar
38
Excel Vers. ve Dili
2016
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

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Kod:
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

𐱅𐰇𐰼𐰚
Katılım
7 Temmuz 2004
Mesajlar
12,271
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
@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...

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

askm

Destek Ekibi
Destek Ekibi
Katılım
4 Haziran 2005
Mesajlar
2,745
Excel Vers. ve Dili
2010-2016
Haluk Bey teşekkürler.
 
Üst