SaveAs

[Arnie]

Morning all firstly thanks in advance for any answers.

I have a spreadsheet that i want to hold in a shared location when anyone
uses it they copy it to there own PC and place it whereever they want.

I need my Macro to be able to get the filename path so that it can be used
1. to carryout a saveAs and request the new filename
2. to reference the file in other macros
3. to get the file path and create a folder called "GeneratedFiles"

an awfull lot i know but no point in posting lots of questions

Regards Arnie

 

[Joel]

Because you have a common file I would copy the file rather than open the
workbook and perform a SaveAs. The code opens a dialog Box to select the
Templet from the common drive. then creates a local directory GeneratedFiles
if the directory doesn't exist. And finally copies the templet to the
Generated Files directory.


Sub CopyFile()
RootFolder = "C:\"
DestinationFolder = "GeneratedFiles"

Set ScriptObj = CreateObject("Scripting.FileSystemObject")

'Get Templete from Networkfile
filetocopy = Application _
.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", _
Title:="Get Templete")
If filetocopy = False Then
MsgBox ("Cannot Open Templete - Exiting Sub")
Exit Sub
End If

'Check if Folder already exists
Found = False
Set F = ScriptObj.GetFolder(RootFolder)
For Each Folder In F.Subfolders
If Folder.Name = DestinationFolder Then
Found = True
Exit For
End If
Next Folder

'if folder does not exist then create
If Found = False Then
'Generate Folder
ScriptObj.CreateFolder (RootFolder & DestinationFolder)
End If

DestFolder = RootFolder & "GeneratedFiles\"

'get source filename from full path name
Set FileObj = ScriptObj.getfile(filetocopy)
BaseName = FileObj.Name

SourceFile = filetocopy
DestinationFile = DestFolder & BaseName
FileCopy SourceFile, DestinationFile ' Copy source to target.


End Sub

 

[Arnie]

Joel thanks for that however i am getting a "permissions Denied" message is
this because the file is already open and therefore it is prevented from
doing so

 

[Joel]

It is possible. It is also possible that the Generated File directory can't
be created. You have to let me know where the error is. Because I'm using
FileCopy and CreateFolder these are the same function that you would use if
you where doing the copy and create using window explorer.

I would first try to create the directory and copy the folder first from
Windows Explorer before I try it with excel.

 

[Arnie]

hi solved the problem of creating the folder by using thisworkbook.path to
get the initial folder to go to so it can create the "GeneratedFiles" Folder

however looking at your code i may have not explained very well.

the user opens this workbook and edits sheet 1 then they need to save the
workbook as another name ie original "Manchester_1234_4321" new name
"Newcastle_1234_4321" i need the SaveAs dialog box come up so the user can
select the original name in this case then chang Manchester to Newcastle.

 

[Joel]

To prevent templete from getting corrupted I just copied the templete to the
new filename and then opened the workbook at the end so the person can make
modifications as required.

Sub CopyFile()
RootFolder = "C:\"
DestinationFolder = "GeneratedFiles"

Set ScriptObj = CreateObject("Scripting.FileSystemObject")

'Get Templete from Networkfile
filetocopy = Application _
.GetOpenFilename(fileFilter:="Excel Files (*.xls), *.xls", _
Title:="Get Templete")
If filetocopy = False Then
MsgBox ("Cannot Open Templete - Exiting Sub")
Exit Sub
End If

'Check if Folder already exists
Found = False
Set F = ScriptObj.GetFolder(RootFolder)
For Each Folder In F.Subfolders
If Folder.Name = DestinationFolder Then
Found = True
Exit For
End If
Next Folder

'if folder does not exist then create
If Found = False Then
'Generate Folder
ScriptObj.CreateFolder (RootFolder & DestinationFolder)
End If

DestFolder = RootFolder & "GeneratedFiles\"

'get source filename from full path name
Set FileObj = ScriptObj.getfile(filetocopy)
BaseName = FileObj.Name

SourceFile = filetocopy

Do
fileSaveName = Application.GetSaveAsFilename( _
InitialFileName:=DestFolder & BaseName, _
fileFilter:="Excel Files (*.xls), *.xls")
Loop While fileSaveName = False


FileCopy SourceFile, fileSaveName ' Copy source to target.
Workbooks.Open Filename:=fileSaveName

End Sub

 

[Arnie]

thanks Joel all
sorted

i am posting a new question if you could help under "SendKeys"