Thank you for your help,
My program is now working! It opens, saves the dxf, and closes all parts in the selected folder.
I share
'-------------------------------------------------------------------------------------------------------------
Option Explicit
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260
Function BrowseFolder(Optional Caption As String, Optional InitialFolder As String) As String
Dim SH As Shell32.Shell
Dim F As Shell32.Folder
Set SH = New Shell32.Shell
Set F = SH. BrowseforFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
If Not F Is Nothing Then
If F = "Desktop" Then
BrowseFolder = About("USERPROFILE") & "\Desktop"
Else
BrowseFolder = F.Items.Item.Path
End If
End If
End Function
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swmodel As SldWorks.ModelDoc
Dim sFileName As String
Dim Path As String
Dim nErrors As Long
Dim nWarnings As Long
Dim swPart As SldWorks.PartDoc
Dim PartNoDes As String
Dim stPath As String
Dim lgFile As Long
Dim blretval As Boolean
Set swApp = Application.SldWorks
' Set swExportPDFData = swApp.GetExportFileData(1)
Path = BrowseFolder("Select a Path/Folder")
If Path = "" Then
MsgBox "Please select the path and try again"
End
Else
Path = Path + "\"
End If
sFileName = Dir(Path & "*.sldprt")
Do Until sFileName = ""
Set swmodel = swApp.OpenDoc6(Path + sFileName, swDocPART, swOpenDocOptions_Silent, "", nErrors, nWarnings)
Set swmodel = swApp.ActiveDoc
Set swPart = swApp.ActiveDoc
If swmodel. GetPathName = "" Then
MsgBox "Please save your document before launching the macro", vbInformation
End
Else
'we get the location of the file
stPath = swmodel. GetPathName
'we get the number of characters up to . of the extension
lgFile = InStrRev(stPath, ".", -1, vbTextCompare) - 1
'we recover the path without the extension
If lgFile > 0 Then
stPath = Left(stPath, lgFile)
End If
End If
'If the document is a document
If swmodel. GetType = swDocPART Then
'we create the unfolded
blretval = swmodel. ExportFlatPatternView(stPath & ". DXF", 1)
The DXF was created
blretval = swmodel. SaveAs3(stPath & ". DXF", 0, 0)
End If
swApp.QuitDoc swPart.GetPathName
Set swPart = Nothing
Set swmodel = Nothing
sFileName = Dir
Loop
MsgBox "All Done"
End Sub
'-------------------------------------------------------------------------------------------------------------