SaveAs to specific folder

[Cardstang]

I'm using Excel 2007

I have a spreadsheet (.xlsm) located on a shared drive that contains some code that is performing some functions, and then when everything is complete, I want to resulting workbook, stripped of the macros (.xlsx) to be saved based on the sheet name, and on the user's computer.

The problem I am running into is that the files on our computers, aren't actually residing on our computers. The company uses a utility of sorts (I think it's named BitLocker) and therefore the location of a User's "My Documents" folder isn't on their C: drive. It may be on one of many servers, and I only know my servername.

Is there anyway to have the code "point" to the dynamic location of the User's My Documents folder? Or really just anywhere that would be considered "local", such as the desktop.

I can get it to save to the location from where the most recent file was opened. This varies, based on where the user opened up a file from. I can also get it to give me a SaveAs dialog, but the file format is .xlsm and the initial location is on the shared drive.

My preference is for the worksheet to save automatically, but I'm OK with a SaveAs dialog.

Here is what I'm currently using, which saves to the location where the most recent file was opened:

Code: Select all

Dim strfilename As String
strfilename = ActiveSheet.Name
ActiveWorkbook.SaveAs strfilename & ".xlsx", 51

I've probably provided too much information, thus making this confusing.

Thanks in advance for the help!

[HansV]

You can obtain the path to the users' (My) Documents folder using

CreateObject("WScript.Shell").SpecialFolders("MyDocuments")

Note that there is no space between My and Documents.

So for example:

Code: Select all

Dim strPath As String
Dim strFileName As String
strPath = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
If Not Right(strPath, 1) = "\" Then
  strPath = strPath & "\"
End If
strFileName = ActiveSheet.Name
ActiveWorkbook.SaveAs strPath & strFileName & ".xlsx", xlOpenXMLWorkbook

[Cardstang]

That did the trick!

Thanks so much.