Error message driving me nuts!

C

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
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
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
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
Open 2 worksheets; closing first spreadsheet
Replies
8
Views
124
keycalinc
K
C
  • Solved
Macro works for one file, does not work for all files in the directory
2
Replies
13
Views
490
Alex Blakenburg
A
J
  • Question
Power Query - Data Refresh Error in Macro
Replies
3
Views
137
bobsan42
bobsan42
C
  • Solved
Run-time error -2147417848 (80010108) automation error: the object invoked has disconnected from its clients
Replies
5
Views
243
NdNoviceHlp
NdNoviceHlp
P
  • Solved
Macro on server based workbook runs fine for me & colleague, but run-time errors for another colleague
Replies
7
Views
454
PerseveringHarold
P

Forum statistics

Threads
1,215,043
Messages
6,122,822
Members
449,096
Latest member
Erald

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top