Error message driving me nuts!

Cath

Board Regular
Joined
Aug 10, 2005
Messages
156
Hi all

I'm working on someone else's macro, on a prodcution machine which I'm not allowed to stop.

I had it running this morning, then stupidly didn't save it and it later crashed and lost it all.

Now when I try and put it back in I am getting an error message. But because there is a error subroutine in the exising macro, I am getting this instead of the 'real' error. And the debugger ends up in the error subroutine instead of where it should be so I'm no wiser as to the problem.

If it goes wrong there's nothing I can do as they then need the machine for production so I just have to give up and go away.

I'd like, within my add-on macro, to say ignore the error subroutine but not sure how. I've tried turning off the error subroutine but this also buggered the macro up. If I can just get it to show me where exactly its going wrong I can sort it out away from the machine.

I've added the error subroutine:

Function IsFileOpen(filename As String)
Dim filenum As Integer, errnumm As Integer

On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnumm = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnumm
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
MsgBox ("Did you select the correct type for the roll. The macro tried to open a file that is not there. See Ewan/Lee/Sharon. The macro will now give an error message saying 'Path not found'. Click on 'End' then correctly select the roll type and re-run. Or, if you click on 'debug' you will see 'Error errnumm' highlighted. Click on the 'STOP' button at the top of that screen, close that screen down, go back to the spreadsheet, correctly select the file type and re-run. If this message appears again, seek help from Ewan/Lee/Sharon.")
Error errnumm
End Select
End Function

(ps I'm getting the "did you select the correct type of roll...." message)

And here is my add-on macro just in case anyone can see any obvious reason why its not working

Sub labelprint()

Dim label, x, checkroll

MsgBox "into labelprint macro"

'pick up checkroll from macro file
Windows("csvfilecheckmacro_31102005.xls").Activate
checkroll = Range("e40").Value

'back to basefile
ActiveWindow.ActivateNext
Sheets("data").Activate

'pick up label number
label = Range("e3").Value
Sheets("result").Activate

MsgBox "then tries to open label file"

'open relevant label file
If checkroll = "13" Or checkroll = "16" Then
If IsFileOpen("c:\PIP2RollBoxLabels.xls") Then
Windows("PIP2RollBoxLabels.xls").Activate
Else
Workbooks.Open filename:="c:\PIP2RollBoxLabels.xls"
End If
Sheets("single PIP2 labels").Activate
End If
If checkroll = "102" Or checkroll = "105" Then
If IsFileOpen("C:\mondriaan-labels.xls") Then
Windows("mondriaan-labels.xls").Activate
Else
Workbooks.Open filename:="C:\mondriaan-labels.xls"
End If
Sheets("single black").Activate
End If
If checkroll = "103" Or checkroll = "106" Then
If IsFileOpen("C:\mondriaan-labels.xls") Then
Windows("mondriaan-labels.xls").Activate
Else
Workbooks.Open filename:="C:\mondriaan-labels.xls"
End If
Sheets("Single Colour").Activate
End If
If checkroll = "104" Or checkroll = "107" Then
If IsFileOpen("C:\mondriaan-labels.xls") Then
Windows("mondriaan-labels.xls").Activate
Else
Workbooks.Open filename:="C:\mondriaan-labels.xls"
End If
Sheets("Single Yellow").Activate
End If

'put label number in and print
Range("b6").Value = label
x = MsgBox("Is this the correct label number? " & label & Chr(13) & "If this is correct and you are ready to print click OK or press enter." & Chr(13) & "Click cancel to exit", vbOKCancel)
Range("a10.f30").Select
If x = vbOK Then Selection.PrintPreview

End Sub

Any help appreciated, I've been and down the stairs so many times today and I'm knackered!!

Cath
 

Some videos you may like

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,660
Not sure if this will help but...
"Function IsFileOpen(filename As String)" should be
Code:
Function IsFileOpen(filename As String) as Boolean
Your macro doesn't have any provision for the file not existing ie. you either try to activate or open the file even though the function has told you the file doesn't exist. Perhaps something like this? Dave
Code:
Function IsFileOpen(filename As String) As Boolean
Dim filenum As Integer, errnumm As Integer

On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnumm = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnumm
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
MsgBox ("Did you select the correct type for the roll. The macro tried to open a file that is not there. See Ewan/Lee/Sharon. The macro will now give an error message saying 'Path not found'. Click on 'End' then correctly select the roll type and re-run. Or, if you click on 'debug' you will see 'Error errnumm' highlighted. Click on the 'STOP' button at the top of that screen, close that screen down, go back to the spreadsheet, correctly select the file type and re-run. If this message appears again, seek help from Ewan/Lee/Sharon.")
Error errnumm
End Select
End Function

Function NoFileError(Flpath As String) As Boolean
'check if file exists.
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.fileexists(Flpath) Then
NoFileError = False
Else
MsgBox "Error: This file does not exist: " & Flpath
NoFileError = True
End If
Set fs = Nothing
End Function

Sub labelprint()

Dim label, x, checkroll

MsgBox "into labelprint macro"

'pick up checkroll from macro file
Windows("csvfilecheckmacro_31102005.xls").Activate
checkroll = Range("e40").Value

'back to basefile
ActiveWindow.ActivateNext
Sheets("data").Activate

'pick up label number
label = Range("e3").Value
Sheets("result").Activate

MsgBox "then tries to open label file"

'open relevant label file
If checkroll = "13" Or checkroll = "16" Then
If NoFileError("c:\PIP2RollBoxLabels.xls") Then
If IsFileOpen("c:\PIP2RollBoxLabels.xls") Then
Windows("PIP2RollBoxLabels.xls").Activate
Else
Workbooks.Open filename:="c:\PIP2RollBoxLabels.xls"
End If
Sheets("single PIP2 labels").Activate
End If
Else
Exit Sub
End If

If checkroll = "102" Or checkroll = "105" Then
If NoFileError("C:\mondriaan-labels.xls") Then
If IsFileOpen("C:\mondriaan-labels.xls") Then
Windows("mondriaan-labels.xls").Activate
Else
Workbooks.Open filename:="C:\mondriaan-labels.xls"
End If
Sheets("single black").Activate
End If
Else
Exit Sub
End If
If checkroll = "103" Or checkroll = "106" Then
If NoFileError("C:\mondriaan-labels.xls") Then
If IsFileOpen("C:\mondriaan-labels.xls") Then
Windows("mondriaan-labels.xls").Activate
Else
Workbooks.Open filename:="C:\mondriaan-labels.xls"
End If
Sheets("Single Colour").Activate
End If
Else
Exit Sub
End If
If checkroll = "104" Or checkroll = "107" Then
If NoFileError("C:\mondriaan-labels.xls") Then
If IsFileOpen("C:\mondriaan-labels.xls") Then
Windows("mondriaan-labels.xls").Activate
Else
Workbooks.Open filename:="C:\mondriaan-labels.xls"
End If
Sheets("Single Yellow").Activate
End If
Else
Exit Sub
End If
'put label number in and print
Range("b6").Value = label
x = MsgBox("Is this the correct label number? " & label & Chr(13) & "If this is correct and you are ready to print click OK or press enter." & Chr(13) & "Click cancel to exit", vbOKCancel)
Range("a10.f30").Select
If x = vbOK Then Selection.PrintPreview

End Sub
 

Cath

Board Regular
Joined
Aug 10, 2005
Messages
156
Thanks a lot, it turns out in the end that the file they had open, which i was checking for, they weren't opening it from the c: drive but from the desktop (which was linked to an old version of the file). Hence when it was looking for the c:\xxxx file it couldn't find it.

When I put in the message boxes in the label print macro it then started showing me where the actual error was instead of going back to the error subroutine.

I will try your subroutine though next time I get access to the machine!

Thanks again :biggrin:

Cath
 

Watch MrExcel Video

Forum statistics

Threads
1,118,089
Messages
5,570,152
Members
412,306
Latest member
fabio6
Top