Delete Drawing Sheets

[CadUser46]

Im trying to delete all drawing sheets and leave only the first page.  I have this so far but it fails after the first time it deletes the last sheet.

I think i have to tell it to re-count the sheets before going back into the for next loop but i dont know how to.

Sub ObsoleteDrawing()

If ThisApplication.ActiveDocument Is Nothing Or ThisApplication.ActiveDocumentType <> kDrawingDocumentObject Then
MsgBox ("Please open a drawing to obsolete")
End If

Dim oDoc As Inventor.DrawingDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oSheets As Sheets
Set oSheets = oDoc.Sheets
Dim i As Integer
i = 1
Dim oSheet As Sheet
Set oSheet = oSheets.Item(i)
oSheet.Activate
    For i = 1 To oDoc.Sheets.Count
        If i > 1 Then
        oSheet.Delete
        End If
    Next
End Sub

[YuhanZhang · Accepted solution]

You can try below Do ... Loop instead of the For ... Next:

      Do While oDoc.Sheets.count > 1
        Set oSheet = oDoc.Sheets.Item(oDoc.Sheets.count)
        oSheet.Delete
      Loop