Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
SaveCopyAs with a twist
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 |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
SaveCopyAs with a twist
1. Yours does the same as mine Dave, except it doesn't add the "BckUpDt"
(date due recalibration). What should happen is a copy of a completed certification is saved with "BckUpDt" preceding the current name in a different folder than the active certification. Mine does that but gives me the message; "Cannot be accessed, may be read only or a read only location, or the server may not be responding". I think the latter is causing the message. Yours saves a copy without the correct date (01-00-00) and a message "SaveCopyAs Failed!" I did not test the network part, no network at home. 2. "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." I didn't want this ether but I get multiple do you want to save messages without it. Thanks Lou "Dave Peterson" wrote: 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 |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
SaveCopyAs with a twist
Sometimes you used:
Range("Bckup") and others Range("BckupDt") I used the first one. And if that cell's text contains characters that can't be used in a filename (like slashes or colons), then you'll have to clean them up first .... & format(range("bckupdt"),"yyyymmdd") & ... ============= I think I'd stay away from the _beforeclose event and just give the user a macro that saved a backup when they clicked a button. I'd include the date & time: .... & format(now,"yyyymmdd_hhmmss") & ... in the filename. The users could do it whenever they wanted and it makes the code much easier to implement. === and while you're debugging, comment out the "on error resume next" line and see what the error actually is. (The one before the saveascopy.) Rookie 1st class wrote: 1. Yours does the same as mine Dave, except it doesn't add the "BckUpDt" (date due recalibration). What should happen is a copy of a completed certification is saved with "BckUpDt" preceding the current name in a different folder than the active certification. Mine does that but gives me the message; "Cannot be accessed, may be read only or a read only location, or the server may not be responding". I think the latter is causing the message. Yours saves a copy without the correct date (01-00-00) and a message "SaveCopyAs Failed!" I did not test the network part, no network at home. 2. "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." I didn't want this ether but I get multiple do you want to save messages without it. Thanks Lou "Dave Peterson" wrote: 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 -- Dave Peterson |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
SaveCopyAs with a twist
"BckUpDt" is a named range that is a copy of dd/mm/yy (Recall Date) in
dd-mm-yy format. "BckUp" is the workbook name. My shorthand is to simply remove all but leading vowels. "Dave Peterson" wrote: Sometimes you used: Range("Bckup") and others Range("BckupDt") I used the first one. And if that cell's text contains characters that can't be used in a filename (like slashes or colons), then you'll have to clean them up first .... & format(range("bckupdt"),"yyyymmdd") & ... ============= I think I'd stay away from the _beforeclose event and just give the user a macro that saved a backup when they clicked a button. I'd include the date & time: .... & format(now,"yyyymmdd_hhmmss") & ... in the filename. The users could do it whenever they wanted and it makes the code much easier to implement. === and while you're debugging, comment out the "on error resume next" line and see what the error actually is. (The one before the saveascopy.) Rookie 1st class wrote: 1. Yours does the same as mine Dave, except it doesn't add the "BckUpDt" (date due recalibration). What should happen is a copy of a completed certification is saved with "BckUpDt" preceding the current name in a different folder than the active certification. Mine does that but gives me the message; "Cannot be accessed, may be read only or a read only location, or the server may not be responding". I think the latter is causing the message. Yours saves a copy without the correct date (01-00-00) and a message "SaveCopyAs Failed!" I did not test the network part, no network at home. 2. "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." I didn't want this ether but I get multiple do you want to save messages without it. Thanks Lou "Dave Peterson" wrote: 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 -- Dave Peterson |
#6
Posted to microsoft.public.excel.misc
|
|||
|
|||
SaveCopyAs with a twist
I guess I was confused about these lines in your original code:
Range("BckUp").Select and ActiveWorkbook.SaveCopyAs Filename:="\\Wizard\Emerald Calibrations\Current Year\" & Range("BckUp").Text Rookie 1st class wrote: "BckUpDt" is a named range that is a copy of dd/mm/yy (Recall Date) in dd-mm-yy format. "BckUp" is the workbook name. My shorthand is to simply remove all but leading vowels. "Dave Peterson" wrote: Sometimes you used: Range("Bckup") and others Range("BckupDt") I used the first one. And if that cell's text contains characters that can't be used in a filename (like slashes or colons), then you'll have to clean them up first .... & format(range("bckupdt"),"yyyymmdd") & ... ============= I think I'd stay away from the _beforeclose event and just give the user a macro that saved a backup when they clicked a button. I'd include the date & time: .... & format(now,"yyyymmdd_hhmmss") & ... in the filename. The users could do it whenever they wanted and it makes the code much easier to implement. === and while you're debugging, comment out the "on error resume next" line and see what the error actually is. (The one before the saveascopy.) Rookie 1st class wrote: 1. Yours does the same as mine Dave, except it doesn't add the "BckUpDt" (date due recalibration). What should happen is a copy of a completed certification is saved with "BckUpDt" preceding the current name in a different folder than the active certification. Mine does that but gives me the message; "Cannot be accessed, may be read only or a read only location, or the server may not be responding". I think the latter is causing the message. Yours saves a copy without the correct date (01-00-00) and a message "SaveCopyAs Failed!" I did not test the network part, no network at home. 2. "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." I didn't want this ether but I get multiple do you want to save messages without it. Thanks Lou "Dave Peterson" wrote: 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 -- Dave Peterson -- Dave Peterson |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Multiple Arguments - New Twist | Excel Worksheet Functions | |||
Twist on the variable rate problem | Excel Worksheet Functions | |||
Siple formula with a twist | Excel Discussion (Misc queries) | |||
Sumif with a twist? | Excel Worksheet Functions | |||
Sorting by Date (With a Twist) | Excel Discussion (Misc queries) |