Solved: my desktop / your desktop

[ndendrinos]

Sub test()
Dim newFile As String
Dim ms As String
ms = Range("A4").Value
newFile = ms
ChDir _
"C:\Users\owner\Desktop"
ThisWorkbook.Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs Filename:=newFile
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub


I want to distribute a file that among other contains this code.
"C:\Users\owner\Desktop" works for me BUT my not work for my customer as the path wording might differ. Is there a solution to this problem , in other words a code that will work for all desktops?


Thank you

[fb7894]

Function SpecialFolderPath() As String

Dim objWSHShell As Object
Dim strSpecialFolderPath

'On Error GoTo ErrorHandler
' Create a shell object
Set objWSHShell = CreateObject("WScript.Shell")
' Find out the path to the passed special folder,
' just change the "Desktop" for one of the other options
SpecialFolderPath = objWSHShell.SpecialFolders("Desktop")
' Clean up
Set objWSHShell = Nothing
Exit Function
ErrorHandler:

MsgBox "Error finding " & strSpecialFolder, vbCritical + vbOKOnly, "Error"
End Function

[ndendrinos]

Thanks for your reply fb7894
Will email the WB to several friends for a test and if OK will come back to marked this "solved"

[GTO]

Dang this 'crashing' laptop...

Same as FB7894's, had just included remainder...

Hope this helps,

Mark

PS - I missed error handling though... Good catch! (@ FB7894: unfortunately you 'remmed' it out)

Sub test()
Dim _
strNewFileName As String, _
wshShell As Object, _
strDesktopPath As String

On Error GoTo ErrorHandler
Set wshShell = CreateObject("WScript.Shell")
strDesktopPath = wshShell.SpecialFolders("Desktop") & "\"
strNewFileName = Trim(Range("A4").Value & ".xls")
ThisWorkbook.Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs Filename:=strDesktopPath & strNewFileName
ActiveWorkbook.Close
Set wshShell = Nothing
Exit Sub

ErrorHandler:
MsgBox "There was an error...", 0, ""
End Sub

[GTO]

Shorter. Also - Sorry, I forgot to mention that example presumes that cell "A4" val would NOT include the ".xls"

A good day to all,

Mark

Sub test()
Dim _
strFullName As String, _
wshShell As Object

On Error GoTo ErrorHandler
Set wshShell = CreateObject("WScript.Shell")

strFullName = wshShell.SpecialFolders("Desktop") & "\" & _
Trim(Range("A4").Value & ".xls")

ThisWorkbook.Sheets("Sheet1").Copy

ActiveWorkbook.SaveAs Filename:=strFullName
ActiveWorkbook.Close

Set wshShell = Nothing
Exit Sub
ErrorHandler:
MsgBox "There was an error...", 0, ""
End Sub

[ndendrinos]

Thank you Mark this works.
fb7894 yours saves teh file as well but not on the desktop.It saves it in c/documents etc...

Thanks to both of you