Error Handling Problem calling Macro from Other Worksheet

[Marcelo Chou]

Hi,
got a problem trying to catch a error when i'm calling a macro from
another workbook using the
Application.Run statement. My code is like this:

Public Sub OpenFileMacro(file_name)

On Error Goto Error
Worbooks.open file_path & file_name ' Open the file
Workbooks("file_name").Activate 'focus to the worksheet
Sheets("sheet_name").Select 'select the target
sheet for the macro
Application.Run (file_name!Macro1) 'Run macro1 from the
worksheet.

Error:
ActiveCell.Offset(0, 1).Value = "Can't Open file or Macro is failing"
'message to write in a cell
For Each oWkBook In Workbooks ' close wb if is
open
If UCase(oWkBook.FullName) = UCase(file_name) Then
Workbooks(file_name).Close savechanges:=False
Exit For
End If
Next
exit sub
End Sub

The code runs from a macro in another workbook with the filenames.
I want to determine which files can run the macro and which can't
writing in a cell in the wb with the filenames.

Can anybody help me?

 

[Joel]

If you comment out the Or Error statements, the code will stop at the error
and then you can figure out what the problem is.

 

[Marcelo Chou]

Thanks.

Oh well, i forgot that the error showing is 1004 "The reference is
invalid".
The error handler doesn't trigger the error block, so i'm out of
ideas.

 

[Dave Peterson]

Application.Run is looking for a string.

Maybe:

Application.Run file_name & "!Macro1"

or in case your file_name needs to be surrounded by apostrophes
(and this won't hurt if the file_name doesn't need them):

Application.Run "'" & file_name & "'!Macro1"

 

[Marcelo Chou]

Application.Run is looking for a string.

Maybe:

Application.Run file_name & "!Macro1"

or in case your file_name needs to be surrounded by apostrophes
(and this won't hurt if the file_name doesn't need them):

Application.Run "'" & file_name & "'!Macro1"

Well, i put the apostrophes but it doesn't help. Thanks anyway.
I think is something with the Application.Run statement running in the
other workbook, so that the error belongs to THAT workbook. Problem is
there are too many files to open, and the wb is password protected.
VBA error handling is a pain in the back and i don't have .net for a
try/catch.

 

[Joel]

You could comment out the open statement and start with the 2nd workbook
already opened. Then you can set break point in the 2nd worksheet and be
abble to debug the problem.

 

[Dave Peterson]

Are you sure that the newly opened file contains a macro named Macro1?

This kind of thing worked for me in my testing.

Option Explicit
Sub testme01()
Dim myCell As Range
Dim myRng As Range
Dim wkbk As Workbook
Dim myPath As String
Dim SheetName As String
Dim MacroName As String

myPath = "C:\my documents\excel"
If Right(myPath, 1) <> "\" Then
myPath = myPath & "\"
End If

SheetName = "Sheet1"
MacroName = "Macro1"

'where the list of workbook names is
With ThisWorkbook.Worksheets("sheet1")
'headers in row 1?
Set myRng = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In myRng.Cells
If IsFileOpen(myCell.Value) Then
myCell.Offset(0, 1).Value = "Please close the file first!"
Else
'try to open it
Set wkbk = OpenMyFile(myPath & myCell.Value)
If wkbk Is Nothing Then
myCell.Offset(0, 1).Value = "Cannot be opened"
Else
'try to change to the sheet
If ChangeToSheet(wkbk, SheetName) = False Then
myCell.Offset(0, 1).Value = "Cannot select Sheet"
Else
'try to run the macro
If RunMacroOk(wkbk, MacroName) = False Then
myCell.Offset(0, 1).Value = "Macro failed"
Else
myCell.Offset(0, 1).Value = "It worked!"
End If

wkbk.Close savechanges:=False 'true???
End If
End If
End If
Next myCell
End Sub
Function IsFileOpen(wkbkName As String) As Boolean
On Error Resume Next
IsFileOpen = CBool(Workbooks(wkbkName).Name <> "")
On Error GoTo 0
End Function
Function OpenMyFile(myFileName As String) As Workbook
'you may want to add readonly:=true
'and not update links
'if you're not going to save the file at the end
Set OpenMyFile = Nothing
On Error Resume Next
Set OpenMyFile = Workbooks.Open(Filename:=myFileName)
On Error GoTo 0
End Function
Function ChangeToSheet(wkbk As Workbook, SheetName As String) As Boolean
On Error Resume Next
Application.Goto reference:=wkbk.Worksheets(SheetName).Range("a1")
ChangeToSheet = CBool(Err.Number = 0)
On Error GoTo 0
End Function
Function RunMacroOk(wkbk As Workbook, MacroName As String) As Boolean
On Error Resume Next
Application.Run "'" & wkbk.Name & "'!" & MacroName
RunMacroOk = CBool(Err.Number = 0)
On Error GoTo 0
End Function


Marcelo Chou wrote: