My moneys on the sheet names having an error so VBA kicks it out to the control of the error handler, try step through line by line to see where it trips out. The code looks sweet thou! VBA Script Written By Gary Hewitt-Long Windows("OUTNOTEmk5_1.XLS").Activate Sheets("Copy").Select Sheets("Copy").Copy
Gary:
Your code is continuing through the "Error Line" programming. You need to interrupt the code before it gets there. Some possibilites are to use a "Goto" before the line, and put the address to go to after the Error Line, or put an "Exit Sub" before the error line.
No, I have checked that, I have three lots of similar code, all working fine unless there is a folder missing.
I have tested this with with directories I know exist, by removing the On Error Goto ErrorLine code and it's subsequent ErrorLine: blah blah blah code.
All works fine without it, but as soon as it is included I know there shouldn't be an error, but it comes up with the message box regardless.
The three different lots of code I do:
save sheet to Drive C
Sub Prison_FileC()
'
'
' VBA Script Written By Gary Hewitt-Long
'
'
On Error GoTo ErrorLine
Windows("OUTNOTEmk5_1.XLS").Activate
Sheets("Copy").Select
Sheets("Copy").Copy
Cells.Select
Selection.Copy
Application.CutCopyMode = False
ActiveSheet.Unprotect
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveSheet.Protect Password:="prisoncopy"
NewNameLocation = Range("[OUTNOTEmk5_1.XLS]Files!A2").Value
NewFileName = Range("[OUTNOTEmk5_1.XLS]Files!A1").Value
ActiveWorkbook.SaveAs Filename:=NewNameLocation
ActiveWorkbook.Close
Windows("OUTNOTEmk5_1.XLS").Activate
Sheets("GENERAL").Select
ErrorLine: MsgBox ("There appears to have been a problem, Please Contact Administrator!!")
ActiveWorkbook.Close
Windows("OUTNOTEmk5_1.XLS").Activate
Sheets("GENERAL").Select
End Sub
Save sheet to drive A
Sub Prison_FileA()
'
' Prison_FileA
' VBA Script Written By Gary Hewitt-Long
'
'
On Error GoTo ErrorLine
FloppyFile = Range("[OUTNOTEmk5_1.XLS]Files!A5").Value
Dim Msg, Style, Title, Ctxt, Response, MyString
Msg = "Would you like to save to Floppy?"
Style = vbYesNo + vbDefaultButton2
Title = "Save to floppy?"
Ctxt = 1000
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.
MsgBox ("Please insert a formatted Floppy Disk into Drive A")
Windows("OUTNOTEmk5_1.XLS").Activate
Sheets("Copy").Select
Sheets("Copy").Copy
Cells.Select
Selection.Copy
Application.CutCopyMode = False
ActiveSheet.Unprotect
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveSheet.Protect Password:="prisoncopy"
ActiveWorkbook.SaveAs Filename:=FloppyFile
ActiveWorkbook.Close
Else
MsgBox ("You have chosen not to save to Disk.")
End If
Windows("OUTNOTEmk5_1.XLS").Activate
Sheets("GENERAL").Select
Windows("OUTNOTEmk5_1.XLS").Activate
ErrorLine: MsgBox ("There appears to have been a problem, Please Contact Administrator")
ActiveWorkbook.Close
Windows("OUTNOTEmk5_1.XLS").Activate
Sheets("GENERAL").Select
End Sub
And finally save sheet to drive A and C
Sub Prison_File()
'
'
' VBA Script Written By Gary Hewitt-Long
'
'
Windows("OUTNOTEmk5_1.XLS").Activate
Sheets("Copy").Select
Sheets("Copy").Copy
Cells.Select
Selection.Copy
Application.CutCopyMode = False
ActiveSheet.Unprotect
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveSheet.Protect Password:="prisoncopy"
NewNameLocation = Range("[OUTNOTEmk5_1.XLS]Files!A2").Value
NewFileName = Range("[OUTNOTEmk5_1.XLS]Files!A1").Value
FloppyFile = Range("[OUTNOTEmk5_1.XLS]Files!A5").Value
ActiveWorkbook.SaveAs Filename:=NewNameLocation
Dim Msg, Style, Title, Ctxt, Response, MyString
Msg = "Would you like to save to Floppy?"
Style = vbYesNo + vbDefaultButton2
Title = "Save to floppy?"
Ctxt = 1000
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' User chose Yes.
MsgBox ("Please insert a formatted Floppy Disk into Drive A")
ActiveWorkbook.SaveAs Filename:=FloppyFile
ActiveWorkbook.Close
Else
ActiveSheet.Close
End If
Windows("OUTNOTEmk5_1.XLS").Activate
Sheets("GENERAL").Select
End Sub
This last one has had the error part removed and works fine. If I remove the ErrorLine part in the other two they work fine as well.
All I want the damn thing to do is not give anyone the chance to see the normal error box which gives them a chance to hit debug (and then totally screw things up).
The only way an error will occur is if the directory hasn't been created before hand, or in the case of saving to floppy, they haven't inserted a Disk.
Regards,
Gary Hewitt-Long
I forgot to mention, the code is working fine without the ErrorLine part and has been for some time, I am just getting fed up of people forgetting to create the appropriate directories when they need new ones.
When this happens an error occurs, they press debug, don't know what they are doing and tend to either delete parts of code (quite often the highlighted part), and then ask me when it doesn't work on anything. :o)
Another angle to get around this would be to check if the directory exists first and if not create it, but this would add extra time to the code running.
Or
To return the error code and TELL the person who run it what went wrong, i.e. you haven't created a directory, or in the case of the floppy disk not being inserted a message box popping up telling them:
MsgBox("Can't you bloody read?? You WERE asked to insert a F####i#g Disk before continuing, by the last message box you idiot.")
:o)
Regards,
Gary Hewitt-Long
Thanks Forgot to put Exit Sub in :o)