Delete Feature Folder With All Children Features

When deleting the top folder in SOLIDWORKS features tree all sub features are not get deleted so it is required to select all of them one-by-one in order to delete folder content.
This is not always possible to do in one step due to the features relations:

Macro can optionally display the confirmation dialog with the list of features about to be deleted

Const SHOW_CONFIRMATION_DIALOG As Boolean = True
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If Not swModel Is Nothing Then
Dim swSelMgr As SldWorks.SelectionMgr
Set swSelMgr = swModel.SelectionManager
Dim swFolderFeat As SldWorks.Feature
Set swFolderFeat = swSelMgr.GetSelectedObject6(1, -1)
If Not swFolderFeat Is Nothing Then
If swFolderFeat.GetTypeName2() = "FtrFolder" Then
Dim vFeats As Variant
vFeats = GetFeaturesInFolder(swFolderFeat)
Dim i As Integer
If Not IsEmpty(vFeats) Then
For i = 0 To UBound(vFeats)
Dim swFeat As SldWorks.Feature
Set swFeat = vFeats(i)
swFeat.Select2 True, -1
Next
End If
If SHOW_CONFIRMATION_DIALOG Then
Dim featNames As String
For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
On Error Resume Next
Set swFeat = swSelMgr.GetSelectedObject6(i, -1)
If Not swFeat Is Nothing Then
featNames = featNames & vbCrLf & swFeat.Name
End If
Next
If swApp.SendMsgToUser2( _
"Delete the following feature(s) and all absorbed features?" & vbCrLf & featNames, _
swMessageBoxIcon_e.swMbQuestion, _
swMessageBoxBtn_e.swMbYesNo) = swMessageBoxResult_e.swMbHitNo Then
End
End If
End If
swModel.Extension.DeleteSelection2 swDeleteSelectionOptions_e.swDelete_Absorbed
Else
MsgBox "Selected feature is not a folder"
End If
Else
MsgBox "Please select folder feature"
End If
Else
MsgBox "Please open model"
End If
End Sub
Function GetFeaturesInFolder(folderFeat As SldWorks.Feature) As Variant
Dim swFeatsColl As Collection
Set swFeatsColl = New Collection
Dim swNextFeat As SldWorks.Feature
Set swNextFeat = folderFeat.GetNextFeature
While Not swNextFeat Is Nothing
If swNextFeat.GetTypeName2() = "FtrFolder" And swNextFeat.Name = folderFeat.Name & "___EndTag___" Then
Dim swFeatsArr() As SldWorks.Feature
If swFeatsColl.Count > 0 Then
ReDim swFeatsArr(swFeatsColl.Count - 1)
Dim i As Integer
For i = 0 To UBound(swFeatsArr)
Set swFeatsArr(i) = swFeatsColl.item(i + 1)
Next
End If
GetFeaturesInFolder = swFeatsArr
Exit Function
End If
If Not Contains(swFeatsColl, swNextFeat) Then
swFeatsColl.Add swNextFeat
End If
CollectAllSubFeatures swNextFeat, swFeatsColl
Set swNextFeat = swNextFeat.GetNextFeature
Wend
End Function
Sub CollectAllSubFeatures(swFeat As SldWorks.Feature, coll As Collection)
Dim swSubFeat As SldWorks.Feature
Set swSubFeat = swFeat.GetFirstSubFeature
While Not swSubFeat Is Nothing
If Not Contains(coll, swSubFeat) Then
coll.Add swNextFeat
End If
CollectAllSubFeatures swSubFeat, coll
Set swSubFeat = swSubFeat.GetNextSubFeature
Wend
End Sub
Function Contains(coll As Collection, item As Object) As Boolean
Dim i As Integer
For i = 1 To coll.Count
If coll.item(i) Is item Then
Contains = True
Exit Function
End If
Next
Contains = False
End Function