Macro to automatically send all currently open parts to Drawing

[netview]

I have been trying to find a way of sending all currently open parts in Solidworks to a the same drawing (perhaps with a 3 views of each part). I have had some success with the following macro found to send all the parts of the currently open assembly to drawing as flat pattern views. Can anyone assist with modifying the code?

Thanks.

Dim swApp As Object
Sub main()
Dim Part As Object
Dim SelMgr As Object
Dim swView As String
Dim swType As String
Dim swFileName As String
Dim swFilePath As String
Dim swParts(0 To 100) As String
Dim boolstatus As Boolean
Dim Feature As Object
Dim Child   As Object
Dim ModDoc As Object
Dim i As Integer
Dim j As Integer
Dim Children    As Variant
Dim InfoText As String
Dim swModel As Object
Dim TopAssy As String
Dim longstatus As Long, longwarnings As Long
Dim PosX As Double, PosY As Double

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
TopAssy = swModel.GetPathName
swType = swModel.GetType
If swType = swDocASSEMBLY Then

Set ModelDoc2 = swApp.ActiveDoc
Set Configuration = ModelDoc2.GetActiveConfiguration
Set Component2 = Configuration.GetRootComponent
Set ModDoc = Component2.GetModelDoc
InfoText = ""

Children = Component2.GetChildren()
ChildCount = UBound(Children) + 1

i = 0

Do While i <> ChildCount
Set Component2 = Children(i)

Set ModDoc = Component2.GetModelDoc
swFileName = Component2.Name2
swFilePath = Component2.GetPathName

 InfoText = InfoText & "Item " & i & swFilePath & " <" & vbNewLine

swParts(i) = swFilePath

i = i + 1
Loop

MsgBox InfoText, vbOKOnly

i = 0
Do While i <> ChildCount

swFilePath = swParts(i)
'  MsgBox ("opening: " & swFilePath)
Set Part = swApp.OpenDoc6(swFilePath, 1, 0, "", longstatus, longwarnings)
swApp.ActiveDoc.ActiveView.FrameLeft = 0
swApp.ActiveDoc.ActiveView.FrameTop = 0
swApp.ActiveDoc.ActiveView.FrameState = 1
swApp.ActiveDoc.ActiveView.FrameState = 1
Set Part = swApp.ActivateDoc2(swFilePath, False, longstatus)

        If Part Is Nothing Then
            Call MsgBox("Unable to open document!", vbExclamation, "Line3")  ' Display error message
        End If
i = i + 1
Loop

Set Part = swApp.ActivateDoc2(TopAssy, False, longstatus)

    sTemplateName = "\\artlfile01\Departmental\Fabrication\TRANSFERRED DATA\Department Documents\Templates & Macro's\Prototype Templates\Blank 1000mm x1000mm.DRWDOT"
    Set swDrawing = swApp.NewDocument(sTemplateName, swDwgPaperAsize, 0#, 0#)

' display sheet format
Set swNewSheet = swDrawing.GetCurrentSheet
swNewSheet.SheetFormatVisible = False
swDrawing.EditSheet

i = 0

Do While i <> ChildCount

swView = swParts(i)
'MsgBox ("creating view: " & swView)

PosX = 0.3 + (0.2 * i)
PosY = 0.3 + (0.02 * i)
'Create view
DrawView = swDrawing.CreateFlatPatternViewFromModelView(swView, "*Top", PosX, PosY, 0)

'set scale
boolstatus = swNewSheet.SetScale(1, 1, True, True)

i = i + 1
Loop

End If

If swType = swDocPART Then
MsgBox ("Its a part")
End If
Set swApp = Application.SldWorks
End Sub