SaveAs (value of (workbook.sheet.cell)).xls.
Open workbook = Filename
|Check out our Excel VBA Resources|
The problem is once you close the original workbook, the macro code to re-open the original workbook is in the closed workbook. So, you can't open the workbook without a shell workbook to hold the code! JSW
Dim CSName As String
Dim OldPath As String
Dim OldFName As String
'This is the cell containing the name for the new book.
CSName = Worksheets("Sheet1").Range("A1").Value
'This is the code to get path & Name data, not used.
'OldPath = ActiveWorkbook.Path
'OldFName = ActiveWorkbook.Name
'Make a copy of the original workbook.
'Save the new workbook.
'Close the new saved workbook.
'Close the original workbook, do not save.
In this case, the original workbook is a read-only template that I created. Data are entered and the workbook is "saved as" the name of a calculated cell, then closed.
When the template is reopened, the data cells are empty and ready to be repopulated.
I think I can use your code for the "save as" part of the macro, then include another statement to clear the data cells on the template. Then, the only problem is to close the newly-created workbook.
Any further suggestions would be greatly appreciated.
1) I have a read-only template that will be populated with data. A certain cell contains a calculated value that I want to use as they name of the saved data.
2) I copy the workbook and give it the name of the calculated cell.
3) I close the new workbook.
4) I clear the values in the template, so it is ready for the next set of data.
I think I can get this done now, although I'd appreciate any further suggestions. Thanks again.
PLEASE TEST....before implimenting as I haven't
fully tested it....
I've commented where poss POST if unsure
IN the ThisWorkbook Object place this code;
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sQ As String
ThisWorkbook.Saved = True
sQ = MsgBox("Do you wish to save this workbook ?", vbYesNoCancel)
If sQ = vbCancel Then Cancel = True
If sQ = vbYes Then
If FSaveAs = False Then
Cancel = True
In a Module place this code;
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
'Converts an item identifier list to a file system path.
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
'Pointer to an item identifier list that specifies a file or directory
'location relative to the root of the name space (the desktop).
'Pointer to a buffer that receives the file system path.
'The size of this buffer is assumed to be MAX_PATH = 260 bytes.
'Returns a pointer to an item identifier list that specifies the location of
'the selected folder relative to the root of the name space. If the user
'chooses the Cancel button in the dialog box, the return value is NULL.
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'lpbrowseinfo = Pointer to a BROWSEINFO structure that contains information
'used to display the dialog box.
Function GetFolderName(msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(msg) Then
bInfo.lpszTitle = "Select a folder." ' the Default dialog title
bInfo.lpszTitle = msg ' the User defined dialog title
bInfo.ulFlags = &H1 ' Type of directory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
path = Space$(512) ' Parse the result
r = SHGetPathFromIDList(ByVal X, ByVal path) '
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
GetFolderName = ""
Function FSaveAs() As Boolean
Dim sDir As String
Dim sFilePwd As String
Dim sFileName As String
FSaveAs = False
sDir = GetFolderName("Please Select a folder to SaveTo")
If sDir = "" Then Exit Function
sFilePwd = Application.InputBox("Enter password", Type:=2)
If sFilePwd = "False" Then Exit Function
sFileName = Sheet1.[A1]
On Error GoTo FileError
ActiveWorkbook.SaveAs Filename:=sDir & "\" & sFileName, _
FSaveAs = True
MsgBox Err.Number & Chr(13) & _
Err.Description & Chr(13), _
vbCritical + vbMsgBoxHelpButton, "ERROR", _
FSaveAs = False