| Home |
| Search |
| Today's Posts |
|
#7
Posted to microsoft.public.excel.misc
|
|||
|
|||
Force a Readonly Workbook to save to a different folder
Thanks Dave, that works a treat
Charlotte "Dave Peterson" wrote: Maybe you can disable any saving and just provide a macro to save to the location of your choice. This all depends on macros being enabled and events being enabled. Behind the ThisWorkbook module: Option Explicit Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Cancel = True MsgBox "Not Saved!!!" & vbLf & "Please use the button to save!" End Sub And provide them some way of saving the workbook (a button from the Forms toolbar on the worksheet???). In fact, some of "forms" I've worked with use a cell in that worksheet as a placeholder for the filename. Maybe you can do something like that (or modify this to get the filename some other way): Behind a general module: Option Explicit Sub SpecialSave() Dim myFileName As String Dim myPath As String Dim TestStr As String Dim resp As Long Dim myErrNumber As Long Dim myErrDesc As String myPath = "C:\temp\" myFileName = ActiveSheet.Range("a1").Value 'some minor checks If Trim(myFileName) = "" Then MsgBox "Please put something in the filename cell!" Exit Sub End If If InStr(1, myFileName, "\", vbTextCompare) 0 _ Or InStr(1, myFileName, "/", vbTextCompare) 0 Then MsgBox "Please fix the filename cell!" Exit Sub End If If LCase(Right(myFileName, 4)) = ".xls" Then 'ok Else myFileName = myFileName & ".xls" End If myFileName = myPath & myFileName 'check for existing files with that name TestStr = "" On Error Resume Next TestStr = Dir(myFileName) On Error GoTo 0 If TestStr = "" Then 'no existing files with that name Else resp = MsgBox(Prompt:="Overwrite existing file?", Buttons:=vbYesNo) If resp = vbNo Then MsgBox "File not saved!" Exit Sub End If End If 'try to save it On Error Resume Next Application.EnableEvents = False Application.DisplayAlerts = False ThisWorkbook.SaveAs FileName:=myFileName, FileFormat:=xlWorkbookNormal myErrNumber = Err.Number myErrDesc = Err.Description Err.Clear Application.DisplayAlerts = True Application.EnableEvents = True On Error GoTo 0 If myErrNumber = 0 Then MsgBox "File saved to: " & ThisWorkbook.FullName Else MsgBox "File Not Saved" & vbLf & myErrNumber & vbLf & myErrDesc End If End Sub Charlotte Howard wrote: Hi, I have created 2 workbooks that are password protected so that end users can only open a read-only copy. They will need to save a copy for themselves, which I want them to do in a particular folder on the network. The Workbook templates are in /finance/valuations, and the workbooks should be saved in /finance/WIP any help appreciated, Charlotte -- Dave Peterson |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| save to folder based on cell value | Excel Discussion (Misc queries) | |||
| open and save an entire folder | Excel Discussion (Misc queries) | |||
| Cannot save excel files to a folder on a network | Excel Discussion (Misc queries) | |||
| How can force enable macros to be able to open my workbook? | Excel Discussion (Misc queries) | |||
| macro save a workbook whilst increasing file no | Excel Worksheet Functions | |||
Threaded Mode
