View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default 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