How to rename all bodies to follow doc name + extention?

Hello, I'm trying to make a macro to rename all bodies in a part to have the document's name + extention.

For example: the part's name is 50001234, now I want the bodies to be named 50001234-01, 50001234-02 etc.

So here is what I have until now:

Option Explicit

Sub main()

Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim swFeat As Feature
Dim swBodyFol As BodyFolder
Dim vBodyArr As Variant

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

swModel.ClearSelection2 True

Set swFeat = swModel.FirstFeature

Do While Not swFeat Is Nothing
If swFeat.GetTypeName = "SolidBodyFolder" Then
Set swBodyFol = swFeat.GetSpecificFeature2
vBodyArr = swBodyFol.GetBodies
RenameBodies swModel, vBodyArr
Exit Do
End If
Set swFeat = swFeat.GetNextFeature
Loop

End Sub

Sub RenameBodies(swModel As SldWorks.ModelDoc2, vBodyArr As Variant)

Dim vBody As Variant
Dim swBody As Body2
Dim prefixName As String
Dim bodycount As Integer
bodycount = 1

If IsEmpty(vBodyArr) Then Exit Sub

prefixName = "doc_name"

For Each vBody In vBodyArr

vBody.Name = prefixName & bodycount

bodycount = bodycount + 1

Next vBody

swModel.EditRebuild3

End Sub

So the body names are now doc_name1, doc_name2 etc. instead of actually following the part's name

I know where the crutch is, but I don't know how to fix it.

Can anyone help out? What do I have to change to get it to work?

Thanks in advance, kind regards,

Albert Koffeman

SolidworksParts And Features