Error Handling Problem calling Macro from Other Worksheet
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:
<<snipped
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.
--
Dave Peterson
|