'---------------------------------------------------------------------------------------
' Procedure : DelWrkSht
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Delete a worksheet from an Excel workbook
' Copyright : It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strWrkBk Workbook to delete the worksheet in/from (full path and filename)
' strWrkSht Worksheet to be deleted
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2008-Feb Initial Release
'---------------------------------------------------------------------------------------
Function DelWrkSht(strWrkBk As String, strWrkSht As String) As Boolean
Dim xlApp As Object
Dim xlWrkBk As Object
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
If Err.Number <> 0 Then
'Could not get instance of Excel, so create a new one
Err.Clear
On Error GoTo DelWrkSht_Error
Set xlApp = CreateObject("excel.application")
Else
On Error GoTo DelWrkSht_Error
End If
Set xlWrkBk = xlApp.Workbooks.Open(strWrkBk)
xlApp.DisplayAlerts = False 'suppress user confirmation prompt
xlApp.Worksheets(strWrkSht).Delete
xlApp.DisplayAlerts = True 're-enable user confirmation prompt
xlApp.Visible = True
Set xlApp = Nothing
Set xlWrkBk = Nothing
DelWrkSht = True
Exit Function
DelWrkSht_Error:
DelWrkSht = False
If Err.Number = 9 Then
'Worksheet not found
MsgBox "Worksheet '" & strWrkSht & "' not found in Workbook '" & strWrkBk & "'", vbCritical
Exit Function
ElseIf Err.Number = 1004 Then
'Workbook not found
MsgBox "Unable to locate Workbook '" & strWrkBk & "'", vbCritical
Exit Function
Else
'Othere Errors
MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Source: DelWrkSht" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occurred!"
Exit Function
End If
End Function