çıkışta farklı kayıt et

[mesutaygun70]

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, ":", "_") & "-" & ThisWorkbook.Name
ds.CopyFile ThisWorkbook.FullName, yol
End If
End Sub

Yukarıdaki gibi bir kod var (excel.web.tr den buldum). Güzel çalışıyor emeği geçenler sağolsun. Ama benim istediğim.
Bu kod d klasöründe yedekler klasörü olup olmadığına bakıyor yoksa oluşturuyor. ve kayıt ediyor. Ama benim istediğim.
Dosyanın bulunduğu klasörün içine baksın yedekler klasörü yoksa oluştursun ve içine kayıt etsin. Yani =Thisworkbook & "\" fonksiyonu ile entegre etmek isyorum ama yapamadım. Yardımcı olabilirmisiniz.

 

[muygun]

Merhaba;

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

Şeklinde deneyin.
İyi çalışmalar.