You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

SolidWorks VBA批量保存文件循环报错(运行时错误91)求助

问题排查与解决方案

错误原因分析

运行时错误91表示对象变量未被正确初始化,结合多选场景和你的代码,核心问题如下:

  1. 对象引用丢失:模块级Part变量在循环中被反复赋值,激活装配体时若失败(比如硬编码的文件名不匹配),会导致Part变为Nothing,下一次循环调用SaveAs3直接报错。
  2. 未验证文件打开结果:调用OpenDoc6后没有检查是否成功打开零件,若文件路径错误或不存在,Part会是Nothing,触发后续方法调用失败。
  3. 硬编码装配体名称:激活装配体时用固定字符串"Mld_Assembly.SLDASM",如果实际装配体文件名不同,激活操作失效,导致对象引用断裂。
  4. 变量声明不规范:多变量一行声明时,仅最后一个变量是指定类型(如Dim MldPartNrFS, MldPartNrMS... As String中仅CheckBxMS为String),其余为Variant,可能引发参数传递异常。
  5. 目标文件夹缺失:保存路径中的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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.06.19 23:37:03