Delete all sheets except a named sheet

[Pat]

I have the following code (in Access 2007), which, after it runs, it still has all the sheets in the xls file.

Code: Select all

    Dim xlApp As Object
    Dim mySheet As Object
    Set xlApp = CreateObject("Excel.Application")
    Set mySheet = xlApp.workbooks.Open(theTemplateFile).Sheets(1)
    
    Dim ws As Worksheet
    For Each ws In xlApp.ActiveWorkbook.Worksheets
        If ws.Name <> "Template" Then
            'ActiveWorkbook.DisplayAlerts = False
            ws.Delete
            'ActiveWorkbook.DisplayAlerts = True
        End If
    Next ws
    mySheet.Parent.Close SaveChanges:=True
    xlApp.Quit

    Set mySheet = Nothing
    Set xlApp = Nothing

I don't know why it's not deleting them?

[steveh]

HI Pat

I was given this code some time ago (here or in the old lounge)

Code: Select all

Sub DelSheets()
Dim SheetCount As Integer

SheetCount = ActiveWorkbook.Sheets.Count

For i = SheetCount To 1 Step -1
ReDim SheetNames(SheetCount)
SheetNames(i) = ActiveWorkbook.Sheets(i).Name

If SheetNames(i) <> "Index" Then
Application.DisplayAlerts = False
Sheets(SheetNames(i)).Delete
End If Next i
End Sub 

Which works for me, HTH

[Pat]

Thanks Steve, i have found a way to do it.

Code: Select all

    Dim objExcel As Excel.Application
    Dim objWorkbook As Excel.Workbook

    Set objExcel = CreateObject("Excel.Application")
    objExcel.Workbooks.Open theTemplateFile

    Set objWorkbook = objExcel.Application.ActiveWorkbook

    objExcel.DisplayAlerts = False

    Do While objWorkbook.Worksheets.Count > 1
        If objWorkbook.Worksheets(objWorkbook.Worksheets.Count).Name <> "Template" Then
            objWorkbook.Worksheets(objWorkbook.Worksheets.Count).Delete
        End If
    Loop
    objWorkbook.Close savechanges:=True
    Set objWorkbook = Nothing
    Set objExcel = Nothing

This does the trick too.