I'm trying to apply the Move/Copy command on a single-bodied part (attached). I saved my commands with the macro recorder and am trying to edit the code to work generally.

What I'm having trouble with is selecting the face of the body. I've been fiddling with the code for ages trying various things, but nothing is working. Any help would be appreciated.

The code below is what I'm working on. It can be pasted into an empty module if neccessary. The first bit of code finds the largest face and I tried to squeeze this in to the Move/Copy code in every way I could imagine but nothing seeems to work. I'm not really sure what the best way forward is. 

Private Sub AfterCreation()

    Dim swSelMgr As SldWorks.SelectionMgr

    Dim swBody As SldWorks.Body2

    Dim swFace As SldWorks.Face2

    Dim swEntity As SldWorks.Entity

    Dim swSelData As SldWorks.SelectData

    Dim swModExt As SldWorks.ModelDocExtension

    Dim Faces As Variant

    Dim Body As Variant

    Dim swPart As SldWorks.ModelDoc2

    Dim swComponent As SldWorks.Component2

    Dim swApp As SldWorks.SldWorks     

    Dim swModel As SldWorks.ModelDoc2  

    Set swApp = Application.SldWorks   

    Set swModel = swApp.ActiveDoc      

    Set swPart = swModel

    Set swModExt = swModel.Extension

    Set swSelMgr = swModel.SelectionManager

    ' Find face with largest surface area to align with front plane

    Dim LargestFaceArea As Double

    Dim CurrentFaceArea As Double

    Body = swPart.GetBodies2(swSolidBody, True)

    swModExt.SelectByID2 Body(0).Name, "SOLIDBODY", 0#, 0#, 0#, True, 0, Nothing, swSelectOptionDefault

    Set swBody = swSelMgr.GetSelectedObject6(1, -1)

     Set swFace = swBody.GetFirstFace

    Do While Not swFace Is Nothing

        CurrentFaceArea = swFace.GetArea

        If CurrentFaceArea > LargestFaceArea Then

            LargestFaceArea = CurrentFaceArea

            swFace.Select (0)

        End If

        Set swFace = swFace.GetNextFace

    Loop

    ' Apply Move/Copy feature

    Dim longstatus As Long

    Dim Component As Object

    Dim FeatureData As Object

    Dim varFeature As Object

    swPart.ClearSelection2 True

    swPart.Extension.SelectByID2 Body(0).Name, "SOLIDBODY", 0, 0, 0, False, 1, Nothing, 0

    Set varFeature = swPart.FeatureManager.InsertMoveCopyBody2(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, False, 1)

    Set FeatureData = varFeature.GetDefinition()

    swPart.Extension.SelectByID2 "", "FACE", 0, 0.05, 0.008, False, 1, Nothing, 0 ' <---- MUST BE GENERALISED!!!

    swPart.Extension.SelectByID2 "Front Plane", "PLANE", 0, 0, 0, True, 1, Nothing, 0

    FeatureData.AddMate Nothing, 0, 0, 0, 0, longstatus

    varFeature.ModifyDefinition FeatureData, swPart, Component

End Sub