Dosya yedekleme (Kod düzeltme)

[ASLAN7410]

Merhaba hayırlı geceler.

Ekte gönderdiğim excel dosyamda dosyanın yedeğini alma makrosu bulunmakta,
bu dosyayı da ortak ağda arkadaşlarla kullanmaktayım. Arkadaşlar bazen verileri
yanlışlıkla silerek kaydettikleri için verileri kurtaramıyorum, hiç değilse ara sıra
dosyanın yedeğini alırsam bazı bilgileri kurtarırım.

Benim yapmak istediğim butona bastığımda sadece benim bilgisayarımın
masaüstündeki YEDEK klasörü içerisine kaydetmesini istiyorum.
Başka kullanıcılar bu butona bastığında Dosyayı yedeklemeyi sadece ADMİN yapabilir, şeklinde uyarı versin.

Bilgisayar oturum adı ADMİN

Yardımcı olur musunuz?

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

.

 

[ASLAN7410]

Aşağıdaki kod içerisindeki siyahla olan kısmı ekleyince tam istediğim gibi oldu.

Belki başkalarının işine de yarar diye ekliyorum.

Sub YedekAlma()
[B]If Application.UserName <> "ADMİN" Then
MsgBox ("Dosyayı yedeklemeyi sadece ADMİN yapabilir,"), vbInformation
Exit Sub
End If[/B]
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