Save As Macro

[LiAD]

Hi,


I would like to put a button into a worksheet which will take the current
file and resave it into the users My Documents under the name of Tester. So
the file will always have the same name and be saved in the My Docs of
whoever is using the file.

This piece of the code is part of a larger code which will remove VBA,
formulas etc to make a smaller file.

Thanks
LiAD

 

[Jacob Skaria]

Copied from your previous query on how to get MyDocuments folder..

In a new module paste the below API function and then within a macro call
Msgbox SpecFolder(CSIDL_PERSONAL)


Public Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hWnd
As Long, ByVal nFolder As Long, ppidl As Long) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" Alias
"SHGetPathFromIDListA" (ByVal Pidl As Long, ByVal pszPath As String) As Long
Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
Public Const CSIDL_PERSONAL = &H5
Public Const CSIDL_DESKTOPDIRECTORY = &H10
Public Const MAX_PATH = 260
Public Const NOERROR = 0

Public Function SpecFolder(ByVal lngFolder As Long) As String
Dim lngPidlFound As Long
Dim lngFolderFound As Long
Dim lngPidl As Long
Dim strPath As String

strPath = Space(MAX_PATH)
lngPidlFound = SHGetSpecialFolderLocation(0, lngFolder, lngPidl)
If lngPidlFound = NOERROR Then
lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
If lngFolderFound Then
SpecFolder = Left$(strPath, InStr(1, strPath, vbNullChar) - 1)
End If
End If
CoTaskMemFree lngPidl
End Function

 

[Joel]

User = Environ("UserProfile")
Folder = User & "\" & "Documents"
FName = Folder & "\" & ThisWorkbook.Name
ThisWorkbook.SaveAs Filename:=FName