Force a Readonly Workbook to save to a different folder

[Guest]

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

 

[Bob Phillips]

Activeworkbbok.SaveAs "C:\Finance\WIP\" & Activeworkbook.Name

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Guest]

Hi, thanks Bob, but I really want the endusers to be automatically directed
to a different folder, and the same one. Knowing them as I do, they will
save in their My Documents, create new folders etc.

When they make changes to the read-only folder, I want them to HAVE to save
the new document to a specific folder. If I just tell them, they'll do their
own thing.

Thanks
Charlotte

 

[Bob Phillips]

How do you propose to force that? Unless you take control of their
environment, and the saving, you cannot stop them browsing to wherever they
wan t to go.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

 

[Guest]

I suppose that I can't really enforce their always saving the workbook in the
correct folder, but if the initial save as goes to a specific folder, then
they are more likely to save in that location.

If I prevent them from saving in the valuations folder themselves, then they
are likely to save it willy-nilly where-ever their fancy takes them. If I
present them with a specific folder, they are more likely to save it there.

Charlotte

 

[Dave Peterson]

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

 

[Guest]

Thanks Dave, that works a treat
Charlotte

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