Kayıt Adının Değişmesi

[1Al2Ver]

Merhaba,

Aşağıdaki kod ile D sürücüsüne yedek alıyorum, yedeklerken tarih, saat ve dosya adını da alarak yedekliyor,

Olabiliyor ise; yol = "D:\YEDEKLER\" & Replace(Now, ":", "_") & "-" & ThisWorkbook.Name yerine Application.StatusBar'daki isimle ve .xlsm uzantısıyla yedeklesin.

Amacım, dosyayı en son kim yedeklemiş onu tespit edebilmek.

(Ben, denememde ;ThisWorkbook.Name yerine Application.StatusBar yazdım ama dosya uzantısını nasıl alacağımı bilemediğimden, dosya uzantısız kayıt edildi, tabi işimi görmedi.)

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
If ds.FolderExists("D:\YEDEKLER") = False Then
ds.CreateFolder "D:\YEDEKLER"
End If
If ThisWorkbook.Path = "D:\YEDEKLER" Then Exit Sub
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "DURUM") = vbYes Then
yol = "D:\YEDEKLER\" & Replace(Now, ":", "_") & "-" & [COLOR="red"]ThisWorkbook.Name[/COLOR]
ds.CopyFile ThisWorkbook.FullName, yol
End If
End Sub

Teşekkür ederim.

 

[cems]

Kırmızı yazı yerinde

 Application.username

veya

 Environ(“Username”)

veya

 Environ(“Computername”)

yazarak dener misiniz ?

Boyle bir dosya olmadığından deneyerek söyleme şansı yok .

 

[1Al2Ver]

Sayın cems merhaba,

Öncelikle ilginiz için teşekkür ederim.

Önerilerinizi uyguladım, benim isteğimi çözmedi, şöyle de olabilir ; ThisWorkbook.Name yerine

"ANASAYFA" B10'daki isim ile kayıt etsin.

Örneğin B10=Mustafa ise, Dosya adı ; 17.09.2017 18_45_28-Mustafa.xlsm

Teşekkür ederim.

 

[halit3]

Bunu denermisiniz.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
yer = "D:\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") = vbYes Then

dosyaadi = ThisWorkbook.FullName
uzanti = "." & ds.GetExtensionName(dosyaadi)
isim = Sheets("ANASAYFA").Cells(10, "b").Value
yol = yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & "-" & isim & uzanti
ds.CopyFile dosyaadi, yol
End If
End Sub

 

[1Al2Ver]

Sayın halit3 merhaba,

Çözüm için çok teşekkür ederim, tam arzuladığım gibi olmuş, elinize sağlık.

Saygılarımla.

 

[halit3]

Teşekkürler iyi çalışmalar