SolidWorks VBA批量保存文件循环报错(运行时错误91)求助
问题排查与解决方案
错误原因分析
运行时错误91表示对象变量未被正确初始化,结合多选场景和你的代码,核心问题如下:
- 对象引用丢失:模块级
Part变量在循环中被反复赋值,激活装配体时若失败(比如硬编码的文件名不匹配),会导致Part变为Nothing,下一次循环调用SaveAs3直接报错。 - 未验证文件打开结果:调用
OpenDoc6后没有检查是否成功打开零件,若文件路径错误或不存在,Part会是Nothing,触发后续方法调用失败。 - 硬编码装配体名称:激活装配体时用固定字符串
"Mld_Assembly.SLDASM",如果实际装配体文件名不同,激活操作失效,导致对象引用断裂。 - 变量声明不规范:多变量一行声明时,仅最后一个变量是指定类型(如
Dim MldPartNrFS, MldPartNrMS... As String中仅CheckBxMS为String),其余为Variant,可能引发参数传递异常。 - 目标文件夹缺失:保存路径中的
XT文件夹未提前创建时,SaveAs3会失败,间接导致对象引用问题。
修正后的完整代码
' 模块级变量声明 Dim swApp As Object Dim assemblyDoc As Object ' 单独存储装配体对象,避免循环中丢失引用 Dim PathCut As String Sub SaveFiles() Set swApp = Application.SldWorks Set assemblyDoc = swApp.ActiveDoc ' 验证当前文档是装配体 If assemblyDoc.GetType <> 2 Then ' 2 = swDocASSEMBLY MsgBox "请先打开装配体文件!", vbExclamation Exit Sub End If ' 提取装配体父路径 Dim PathInit As String PathInit = assemblyDoc.GetPathName If PathInit = "" Then MsgBox "装配体未保存,请先保存装配体!", vbExclamation Exit Sub End If PathCut = Left(PathInit, InStrRev(PathInit, "\")) ' 自动创建XT文件夹(如果不存在) Dim xtFolderPath As String xtFolderPath = PathCut & "XT\" If Dir(xtFolderPath, vbDirectory) = "" Then MkDir xtFolderPath End If ' 打开用户窗体 UserParam.Show End Sub Public Sub UserInput(InputMldPartNrFS As String, InputMldPartNrMS As String, InputREVCodeNr As String, _ InputCheckBxFS As Boolean, InputCheckBxMS As Boolean, OptionExtension As String, InputArrayParts As String) Dim MldPartNrFS As String, MldPartNrMS As String, REVCodeNR As String Dim ArrayList As Variant Dim ExtInit As String, ExtNew As String Dim initName As String Dim SavePart As Long Dim i As Integer Dim partDoc As Object ' 局部变量存储当前零件,避免覆盖装配体引用 ' 初始化参数 ExtInit = ".SLDPRT" ' 确保扩展名格式正确 ExtNew = IIf(OptionExtension = "X_T", ".x_t", ".step") MldPartNrFS = InputMldPartNrFS MldPartNrMS = InputMldPartNrMS REVCodeNR = "[REV" & InputREVCodeNr & "]" ArrayList = Split(InputArrayParts, ",") ' 遍历选中零件 For i = LBound(ArrayList) To UBound(ArrayList) initName = PathCut & ArrayList(i) & ExtInit ' 检查零件文件是否存在 If Dir(initName) = "" Then MsgBox "零件文件不存在:" & initName, vbExclamation GoTo NextPart End If ' 打开零件并验证结果 Dim longstatus As Long, longwarnings As Long Set partDoc = swApp.OpenDoc6(initName, 1, 0, "", longstatus, longwarnings) If partDoc Is Nothing Then MsgBox "打开零件失败:" & initName & ",错误码:" & longstatus, vbExclamation GoTo NextPart End If ' 提取零件编码并验证 Dim partNumber As String partNumber = NumPart(initName) If partNumber = "" Then MsgBox "无法提取零件编码:" & initName, vbExclamation GoTo ClosePart End If ' 生成保存路径并执行保存 Dim savePath As String savePath = PathCut & "XT\" & partNumber & "_" & MldPartNrFS & " " & ArrayList(i) & " " & REVCodeNR & ExtNew SavePart = partDoc.SaveAs3(savePath, 0, 2) If SavePart <> 0 Then MsgBox "保存失败:" & savePath & ",错误码:" & SavePart, vbExclamation End If ClosePart: ' 关闭当前零件,避免打开过多文件 swApp.CloseDoc initName NextPart: Next i ' 重新激活装配体 swApp.ActivateDoc2 assemblyDoc.GetTitle, False, longstatus Set assemblyDoc = swApp.ActiveDoc End Sub Function NumPart(initName As String) As String Dim arr As Variant, arrEl As Variant, El As Variant arr = Split(initName, "\") For Each El In arr arrEl = Split(El, "_") If UBound(arrEl) = 2 Then If IsNumeric(arrEl(1)) Then NumPart = arrEl(1) Exit Function End If End If Next El ' 未找到编码时返回空字符串 NumPart = "" End Function
关键修正点说明
- 分离对象引用:用
assemblyDoc单独存储装配体对象,局部变量partDoc处理当前零件,避免循环中覆盖引用导致对象丢失。 - 增加前置检查:验证装配体状态、零件文件存在性,自动创建目标文件夹,从源头避免路径错误。
- 规范变量类型:每个变量单独声明类型,消除Variant隐式转换带来的异常。
- 验证对象初始化:打开零件后检查
partDoc是否有效,避免调用空对象方法。 - 动态获取装配体名称:用
assemblyDoc.GetTitle替代硬编码,确保激活操作可靠。
内容的提问来源于stack exchange,提问作者JetskiS
相关产品推荐
相关产品推荐

