Çözüldü Yedek alırken istenilen yerin seçilmesi

[massgrave]

Merhaba;
Aşağıdaki kod ile Yedeği C:\YEDEK konumuna alabiliyorum. Fakat ben;

- Gözat penceresi ile yedeğin nereye alınacağını seçmek istiyorum.
- Yedek alınan sayfada userfırmu açmak için gereken butonda var yedek alırken onuda dahil ediyor. Onu almamasını istiyorum.

Yardımcı olur musunuz.

Private Sub CommandButton7_Click()
YesNo = MsgBox("Data Yedeği 'C:\YEDEK\ ' Konumuna alınacaktır. Onaylıyor musunuz?", vbYesNo + vbInformation, "DATA'YI YEDEKLE")
Select Case YesNo
Case vbYes
    If Not CreateObject("Scripting.FileSystemObject").FolderExists("C:\YEDEK") Then
    CreateObject("Scripting.FileSystemObject").CreateFolder ("C:\YEDEK")
    End If
    Sheet2.Copy
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="C:\YEDEK\" & ActiveSheet.Name & "_" & Format(Now(), "mm.dd.yy_hh.mm") & ".xlsx"
    ActiveWorkbook.Close
    Application.Visible = False
    End Select
End Sub

 

[PLİNT]

Merhaba
Aşağıdaki gibi deneyiniz
(Silinecek buton (activex denetimi) "commandbutton" nesnesi ise )

Private Sub CommandButton7_Click()
 Dim a As OLEObject
 '......
     'Set klasorsec = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör seçiniz", 0, "c:\")
 '.....
 
Set klasorsec = CreateObject("Shell.Application").BrowseForFolder(0, "Klasör seçiniz", 0)

If Not klasorsec Is Nothing Then yol = klasorsec.SELF.Path
If yol = False Then Exit Sub
If Not CreateObject("Scripting.FileSystemObject").FolderExists(yol) Then
MsgBox "Seçilen bölüm Kayıt için uygun değil"
Exit Sub
End If
YesNo = MsgBox("Data Yedeği " & "'" & yol & "'" & "  Konumuna alınacaktır. Onaylıyor musunuz?", vbYesNo + vbInformation, "DATA'YI YEDEKLE")
Select Case YesNo
Case vbYes

   Sheet2.Copy
    Application.DisplayAlerts = False
  
For Each a In ActiveWorkbook.ActiveSheet.OLEObjects
If TypeName(a.Object) = "CommandButton" Then a.Delete
Next
    ActiveWorkbook.SaveAs Filename:=yol & "\" & ActiveSheet.Name & "_" & Format(Now(), "mm.dd.yy_hh.mm") & ".xlsx"
    
    ActiveWorkbook.Close
    Application.Visible = False
    End Select

End Sub

 

[massgrave]

Teşekkürler