DEVelopers HUT

'---------------------------------------------------------------------------------------
' Procedure : RunXLSMacro
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Open the specifed Excel workbook and run the specified macro and then
'             close the workbook.
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Sep-09                 Initial Release
'---------------------------------------------------------------------------------------
Function RunXLSMacro(sFile As String, sMacroName As String) As String
'Requires a reference to the Microsoft Excel xx.0 Object Library
On Error GoTo Error_Handler
    Dim xlApp       As Object
    Dim xlWb        As Object
    Dim sFileName   As String
 
    Set xlApp = CreateObject("Excel.Application") 'Create an Excel instance
    Set xlWb = xlApp.Workbooks.Open(sFile, True)  'Open the specified workbook
    xlApp.Visible = True                          'Control whether or not to show Excel
                                                    'to your user
    
    sFileName = Right(sFile, Len(sFile) - InStrRev(sFile, "\"))
 
    xlApp.Run sFileName & "!" & sMacroName         'Execute the specified macro

Error_Handler_Exit:
    On Error Resume Next
    xlWb.Close (True)                             'Save the excel workbook
    xlApp.Quit                                    'Close/Quit Excel
    Set xlWb = Nothing
    Set xlApp = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: RunXLSMacro" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function