If error finding and saving to desktop path

[sdoppke]

Hi everyone I have a script that finds the desktop path and save a file there for me (see below) I have found out some users have insufficient admin rights and saving to the desktop willnot be an option. Could someone help me edit this function/script to bring up a message box if this happens (error) and then it will close the file without saving (kick them off)

Thank a ton in advacne for any help.

sd

Function GetDesktopPath() As String
  Dim DskTop As String
  Dim WSH As Object
 
    Set WSH = CreateObject("WScript.Shell")
    DskTop = WSH.SpecialFolders("desktop")
 
    GetDesktopPath = DskTop
 
   'Free the object reference and memory allocated
    Set WSH = Nothing
 
End Function

Private Sub CommandButton1_Click()
     'Saves filename as value of A1 plus the current date
Store = Sheets("MyStoreInfo").Range("C2")
    Dim newFile As String, fName As String, sName As String
     ' Save to the User's Desktop
      ActiveWorkbook.SaveAs Filename:=Store & "WFMScheduleTool" & ".xlsm"
SaveWFMTool.Hide
End Sub

 

[Warship]

Maybe:

Private Sub CommandButton1_Click()
On Error GoTo ErrorPresent
     'Saves filename as value of A1 plus the current date
Store = Sheets("MyStoreInfo").Range("C2")
    Dim newFile As String, fName As String, sName As String
     ' Save to the User's Desktop
      ActiveWorkbook.SaveAs Filename:=Store & "WFMScheduleTool" & ".xlsm"
SaveWFMTool.Hide
Exit Sub
ErrorPresent:
MsgBox "Can't Save"
End Sub

 

[sdoppke]

Maybe:

Private Sub CommandButton1_Click()
On Error GoTo ErrorPresent
     'Saves filename as value of A1 plus the current date
Store = Sheets("MyStoreInfo").Range("C2")
    Dim newFile As String, fName As String, sName As String
     ' Save to the User's Desktop
      ActiveWorkbook.SaveAs Filename:=Store & "WFMScheduleTool" & ".xlsm"
SaveWFMTool.Hide
Exit Sub
ErrorPresent:
MsgBox "Can't Save"
End Sub

Brilliant!! thanks for helpin out!!
sd