Export Each Part in an Assembly

I've borrowed a some code for my macro form this forum,primarily from Bert De Spiegelaere.

I open an assembly then start the macro. For each part in theassembly it opens the part, saves it as a step file, then closesthe part. Then goes to the next part in the assembly.

It all works pretty good. My problem is that it runs out of memoryat 50 parts. My assembly has about 100.

Is there something I need to do to remove a part from memory afterI close the part file.
Does anyone know of a better way.


Dim swApp As SldWorks.SldWorks
Dim modeldoc2 As SldWorks.modeldoc2
Dim swAssy As AssemblyDoc
Dim vs As Variant
Dim v As Variant
Dim CurrentswComp, swCompDir As String

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim a As String
Dim b As String
Dim x As Boolean

Sub main()

Set swApp = Application.SldWorks

Set modeldoc2 = swApp.ActiveDoc

If modeldoc2.GetType = swDocASSEMBLY Then

Set swAssy = modeldoc2

vs = swAssy.GetComponents(False)

For Each v In vs
Set swComp = v
CurrentComp = swComp.GetPathName
swCompDir = NewParseString(UCase(CurrentComp), "\", 1, 0)
swCompName = NewParseString(UCase(CurrentComp), "\", 1, 1)


a = swCompName
b = swCompDir
x = MakeStep(b, a)

Next v
End If

End Sub
-------------------------------------------------------------------------

Function NewParseString(theString As String, stringToFind AsString, _
Occur As Boolean, StrRet As Integer)
Location = 0
TempLoc = 0
PosCount = 1
While PosCount < Len(theString)
TempLoc = InStr(PosCount, theString, stringToFind)
If TempLoc <> 0 Then
If Occur = 0 Then
If Location = 0 Then
Location = TempLoc
End If
Else
Location = TempLoc
End If
PosCount = TempLoc + 1
Else
PosCount = Len(theString)
End If
Wend
If Location <> 0 Then
If StrRet = 0 Then
theString = Mid(theString, 1, Location - 1)
Else
theString = Mid(theString, Location + Len(stringToFind))
End If
ElseIf StrRet = 2 Then
theString = ""
End If
NewParseString = theString
End Function
----------------------------------------------------------------------------

Function MakeStep(sPath As String, sFile As String)

Set Part = swApp.ActiveDoc
'Set Part = swApp.OpenDoc6("C:\Documents and Settings\strohtm\MyDocuments\Solidworks\Working Folder\Heat Treat\FP-1613.SLDPRT", 1,0, "", longstatus, longwarnings)
Set Part = swApp.OpenDoc6(sPath & "\" & sFile, 1, 0, "",longstatus, longwarnings)
'Dim myModelView As Object
'Set myModelView = Part.ActiveView

'myModelView.FrameLeft = 0
'myModelView.FrameTop = 21
'Set myModelView = Part.ActiveView
'myModelView.FrameState = swWindowState_e.swWindowMaximized
'Set myModelView = Part.ActiveView
'myModelView.FrameState = swWindowState_e.swWindowMaximized

'swApp.ActivateDoc2 "FP-1613.SLDPRT", False, longstatus
swApp.ActivateDoc2 sFile, False, longstatus
Set Part = swApp.ActiveDoc

'longstatus = Part.SaveAs3("C:\Documents and Settings\strohtm\MyDocuments\Solidworks\Working Folder\Heat Treat\Quench Turret inSTEP\FP-1613.STEP", 0, 0)
'longstatus = Part.SaveAs3(sPath & "\" & sFile &".STEP", 0, 0)
longstatus = Part.SaveAs3("C:\Documents and Settings\strohtm\MyDocuments\Solidworks\Working Folder\step export\" & sFile &".STEP", 0, 0)

swApp.CloseDoc sFile

End FunctionSolidworksApi macros