SaveCopyAs with a twist
How about testing to see if that network folder exists and then have the code go
to either that network folder or go to the C: drive. In either case, this code
assumes that the folder exists--but you could create it with a couple of mkdir
commands.
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim TestStr As String
Dim Response As Long
Dim myFolder As String
Dim myNewName As String
myFolder = "\Emerald Calibrations\Current Year\"
'Range("BckUp").Select
'Application.ScreenUpdating = False
'ActiveSheet.Unprotect
Response = MsgBox(Prompt:="Would You Like to Create a Back-Up Copy?", _
Buttons:=vbYesNo + vbDefaultButton1, Title:="BACK-UP COPY")
If Response = vbYes Then
TestStr = ""
On Error Resume Next
TestStr = Dir("\\wizard" & myFolder & "\nul")
On Error GoTo 0
If TestStr = "" Then
'no network drive connection, go to the C: drive???
myNewName = "C:" & myFolder
Else
myNewName = "\\wizard" & myFolder
End If
myNewName = myNewName & Range("Bckup").Value & " " & Me.Name
On Error Resume Next
Me.SaveCopyAs Filename:=myNewName
If Error.Number < 0 Then
MsgBox "SaveCopyAs Failed!"
Cancel = True 'don't close?????
Else
MsgBox "Backup saved into: " & myNewName
End If
On Error GoTo 0
End If
'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
'Application.ScreenUpdating = True
'Me.Saved = True
End Sub
This has only been lightly tested. You'll want to test further.
And with me.Saved = true, the user won't be prompted to save any changes they've
made since that last change. I'm not sure I'd do that.
In fact, if they choose to make a backup, but not do the save, then the backup
isn't really a backup!
Rookie 1st class wrote:
The following worked until I had to add the second line (Oops) for laptops
away from the facility. It still functions properly but I get en error
message. What is the correct to fix this problem?
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'On Close
Range("BckUp").Select
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Response = MsgBox(Prompt:="Would You Like to Create a Back-Up Copy?",
Buttons:=vbYesNoCancel + vbDefaultButton1, Title:="BACK-UP COPY")
If Response = vbYes Then
BookName = ActiveWorkbook.Name
Selection = ClearContents
Selection = InputBox(Prompt:="Your Back-Up Form Name Will Be Like
the Window Below.", Title:="BACK-UP COPY", Default:=Range("BckUpDt").Text + "
" + (BookName))
On Error GoTo Oops
ActiveWorkbook.SaveCopyAs Filename:="\\Wizard\Emerald
Calibrations\Current Year\" & Range("BckUp").Text
Oops:
ActiveWorkbook.SaveCopyAs Filename:="\Emerald Calibrations\Current
Year\" & Range("BckUp").Text
ElseIf Response = vbCancel Then
Exit Sub
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
ThisWorkbook.Saved = True
End Sub
TIA
Lou
--
Dave Peterson
|