Ich möchte ein Makro ausführen, um alle Zeichnungen eines Ordners und Unterordner zu öffnen.
Im Moment wähle ich einen Ordner aus, aber es werden nur die Zeichnungen geöffnet, die im Ordner enthalten sind, und nicht in den Unterordnern.
Wie wird die Methode zum Abrufen von Unterordnern eines Verzeichnisses verwendet, um die enthaltenen Dateien zu öffnen?
Hier ist mein Code-Schnipsel, der es mir ermöglicht, die Zeichnungen eines Ordners zu öffnen:
CurrentPath = CurrentPath & "\"
sfilename = Dir(CurrentPath & "*.slddrw")
'Ouverture des mises en plan dans le dossier
Do Until sfilename = ""
'Ouverture
Set swApp = Application.SldWorks
Set swModel = swApp.OpenDoc6(CurrentPath & sfilename, 3, 0, "", longstatus, longwarnings)
swApp.ActivateDoc2 sfilename, False, longstatus
Set swModel = swApp.ActiveDoc
sfilename = dir
Loop
Hallo, Sie müssen die Unterordner auflisten und den Vorgang wiederholen.
Schauen Sie sich dieses Beispiel mit FSO an: https://www.developpez.net/forums/d976685/logiciels/microsoft-office/excel/macros-vba-excel/lister-dossiers-sous-dossiers/#post5476972
Ich habe es geschafft, in meinem Makro voranzukommen. Bei großen Dateien mit mehr als 150 Zeichnungen wird mir jedoch mitgeteilt, dass meine Fensterressourcen nicht ausreichen, während ich jede Zeichnung öffne, sie in PDF und DXF in verschiedenen Zeichnungsformaten speichere und sofort schließe.
Zu Ihrer Information, hier ist mein Makro, um die Zeichnungen im Zielverzeichnis und die Zeichnungen in den Unterordnern zu öffnen:
Set swApp = Application.SldWorks
'Sélection du dossier
CurrentPath = SelectFolder("Select Folder", "")
If CurrentPath = "" Then
Exit Sub
End If
CurrentPath = CurrentPath & "\"
sfilename = Dir(CurrentPath & "*.slddrw")
'Ouverture des mises en plan dans le dossier
Do Until sfilename = ""
'Ouverture
Set swApp = Application.SldWorks
Set swModel = swApp.OpenDoc6(CurrentPath & sfilename, 3, 0, "", longstatus, longwarnings)
swApp.ActivateDoc2 sfilename, False, longstatus
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox ("Ouvrer une mise plan")
Else
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
Set swModelDocExt = swModel.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
Set swLayerMgr = swModel.GetLayerManager
Set swLayer = swLayerMgr.GetLayer("CLIENT")
vLayerArr = swLayerMgr.GetLayerList
Presence_Client = False
For Each vLayer In vLayerArr
If vLayer = "CLIENT" Then
Presence_Client = True
End If
Next
'Opération sur nom du fichier
nom_Fichier = Strings.Left(swModel.GetPathName, Strings.Len(swModel.GetPathName) - 7)
nom_Ouvrir = swModel.GetPathName
Extension = Strings.Right(swModel.GetPathName, 7)
'Cache le calque CLIENT
If Presence_Client = True Then
If swLayer.Visible = True Then
swLayer.Visible = False
End If
End If
swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""
swExportPDFData.ViewPdfAfterSaving = False
'Active la première feuille
vSheetName = swDraw.GetSheetNames
bRet = swDraw.ActivateSheet(vSheetName(0))
'Enregistrement en PDF DXF PDF
bRet = swModel.Extension.SaveAs(nom_Fichier & " EXT.PDF", 0, 0, swExportPDFData, nErrors, nWarnings)
longstatus = swModel.SaveAs(nom_Fichier & " EXT.DXF")
DoEvents
If Presence_Client = True Then
swLayer.Visible = True
End If
longstatus = swModel.SaveAs(nom_Fichier & ".PDF")
'Fermeture du document
swApp.QuitDoc (nom_Ouvrir)
DoEvents
End If
sfilename = Dir
Loop
CurrentPath = Left(CurrentPath, Len(CurrentPath) - 1)
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(CurrentPath)
CurrentPath = CurrentPath & "\"
'Ouverture des mises en plan dans les sous-dossiers
For Each SubFolder In SourceFolder.SubFolders
ssDossier = SubFolder.Path & "\"
sfileNamessdossier = Dir(ssDossier & "*.slddrw")
Do Until sfileNamessdossier = ""
'Ouverture
Set swApp = Application.SldWorks
Set swModel = swApp.OpenDoc6(ssDossier & sfileNamessdossier, 3, 0, "", longstatus, longwarnings)
swApp.ActivateDoc2 sfileNamessdossier, False, longstatus
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox ("Ouvrer une mise plan")
Else
Set swDraw = swModel
Set swSheet = swDraw.GetCurrentSheet
Set swModelDocExt = swModel.Extension
Set swExportPDFData = swApp.GetExportFileData(1)
Set swLayerMgr = swModel.GetLayerManager
Set swLayer = swLayerMgr.GetLayer("CLIENT")
vLayerArr = swLayerMgr.GetLayerList
Presence_Client = False
For Each vLayer In vLayerArr
If vLayer = "CLIENT" Then
Presence_Client = True
End If
Next
'Opération sur nom du fichier
nom_Fichier = Strings.Left(swModel.GetPathName, Strings.Len(swModel.GetPathName) - 7)
nom_Ouvrir = swModel.GetPathName
Extension = Strings.Right(swModel.GetPathName, 7)
'Cache le calque CLIENT
If Presence_Client = True Then
If swLayer.Visible = True Then
swLayer.Visible = False
End If
End If
swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""
swExportPDFData.ViewPdfAfterSaving = False
'Active la première feuille
vSheetName = swDraw.GetSheetNames
bRet = swDraw.ActivateSheet(vSheetName(0))
'Enregistrement en PDF DXF PDF
bRet = swModel.Extension.SaveAs(nom_Fichier & " EXT.PDF", 0, 0, swExportPDFData, nErrors, nWarnings)
longstatus = swModel.SaveAs(nom_Fichier & " EXT.DXF")
DoEvents
If Presence_Client = True Then
swLayer.Visible = True
End If
longstatus = swModel.SaveAs(nom_Fichier & ".PDF")
'Fermeture du document
swApp.QuitDoc (nom_Ouvrir)
DoEvents
End If
sfileNamessdossier = Dir
Loop
'Unload sfileNamessdossier
Next SubFolder
MsgBox ("FINI!")
Meiner Meinung nach ist auf den ersten Blick das Set swApp = Application.SldWorks das Problem. Von dem Moment an, in dem Sie eine Solidworks-Sitzung geöffnet haben, müssen Sie sie nur noch offen lassen und wieder in den Vordergrund stellen, ohne sie mit einem neuen swApp-Set erneut zu verwenden.
So wie es aussieht, müssen Sie mehrere SW-Prozesse geöffnet haben, und das ist es, was bei einer großen Datei abstürzt.