Solidworks VBA批量保存文件时覆盖弹窗异常问题求助

我编写了用于保存SolidWorks文件的VBA代码，该代码可检查目标文件夹中是否已存在文件，若存在则通过MsgBox弹窗询问是否覆盖。当前代码在处理单个文件时正常，但批量处理多个文件时存在异常：当对第一个已存在文件选择「No（不覆盖）」后，代码会直接返回用户表单，不再询问后续已存在文件的覆盖确认。现需修改代码，使流程即使在选择不覆盖前一个文件时，仍能继续询问后续文件的覆盖操作。

原代码 #

Main sub()
PathInit = Part.GetPathName                         'Determine file location of the assembly
PathCut = Left(PathInit, InStrRev(PathInit, "\"))   'Remove text \"Assembly.SLDASS\" after the last slash
initName = PathCut + ArrayList(i) + ExtInit                                                                                                                                     'Name to open the original file
finalName = PathCut & FolderName & "\" & NumPart(initName) & "_" & mldpartcode & " " & ArrayListAdapted & " " & "[REV" & UserParam.getREV(UserParam, CStr(ArrayListNr(i))) & "]" & ExtNew  'New filename
finalNameCut = NumPart(initName) & "_" & mldpartcode & " " & ArrayListAdapted & " " & "[REV" & UserParam.getREV(UserParam, CStr(ArrayListNr(i))) & "]" & ExtNew

 For i = LBound(ArrayList) To UBound(ArrayList) 'Run loop x times depending on the amount of selected checkboxes in the userform
    'Save the file if it does not exist yet
    Dim FileNameOverwrite
    Dim IsToBeSaved
    IsToBeSaved = True
    
    If Not Dir(finalName, vbDirectory) = vbNullString Then
        FileNameOverwrite = MsgBox("Filename " & finalNameCut & " already exists. Do you want to overwrite?", vbQuestion + vbYesNoCancel, "File overwrite")
        UserParam.Hide
        If FileNameOverwrite = vbNo Then
            UserParam.Show
            IsToBeSaved = False
            'Exit Sub ' Stop the code execution, no more looping
        End If
        If FileNameOverwrite = vbCancel Then
            UserParam.Show
            Exit Sub
        End If
    End If
    
    If IsToBeSaved Then
        swModelToExport.Extension.SaveAs3 finalName, 0, 1, Nothing, Nothing, nErrors, nWarnings
    End If
    
    'Close all the files
    swApp.CloseDoc ArrayList(i) & ".SLDPRT"
     
    'Reopen assembly
    Set swModel = swApp.OpenDoc6(PathInit, 1, 0, "", nStatus, nWarnings)                                                    'Open the model
    Set swModelActivated = swApp.ActivateDoc3(PathInit, False, swRebuildOnActivation_e.swUserDecision, nErrors)             'Activate the model
    Set swModelToExport = swApp.ActiveDoc                                                                                   'Get the activated model
 Next
End Sub

问题分析 #

1. 文件名变量计算位置错误：initName、finalName、finalNameCut在循环外部定义，此时i未进入循环迭代，导致所有循环都使用错误的文件名（甚至是未初始化的i对应的值）。
2. 模态弹窗中断循环：选择「No」时调用UserParam.Show，该方法为模态显示，会暂停当前代码执行并返回表单，导致后续循环无法继续。

修改后的代码 #

Sub Main()
    Dim PathInit As String
    Dim PathCut As String
    Dim initName As String
    Dim finalName As String
    Dim finalNameCut As String
    Dim i As Integer
    Dim FileNameOverwrite As VbMsgBoxResult
    Dim IsToBeSaved As Boolean
    Dim nErrors As Long, nWarnings As Long
    Dim nStatus As Long
    
    PathInit = Part.GetPathName                         'Determine file location of the assembly
    PathCut = Left(PathInit, InStrRev(PathInit, "\"))   'Remove text "Assembly.SLDASS" after the last slash

    For i = LBound(ArrayList) To UBound(ArrayList) 'Run loop x times depending on the amount of selected checkboxes in the userform
        ' 每次循环重新计算当前文件的文件名
        initName = PathCut + ArrayList(i) + ExtInit
        finalName = PathCut & FolderName & "\" & NumPart(initName) & "_" & mldpartcode & " " & ArrayListAdapted & " " & "[REV" & UserParam.getREV(UserParam, CStr(ArrayListNr(i))) & "]" & ExtNew
        finalNameCut = NumPart(initName) & "_" & mldpartcode & " " & ArrayListAdapted & " " & "[REV" & UserParam.getREV(UserParam, CStr(ArrayListNr(i))) & "]" & ExtNew
        
        IsToBeSaved = True
        
        If Not Dir(finalName, vbDirectory) = vbNullString Then
            FileNameOverwrite = MsgBox("Filename " & finalNameCut & " already exists. Do you want to overwrite?", vbQuestion + vbYesNoCancel, "File overwrite")
            UserParam.Hide
            
            Select Case FileNameOverwrite
                Case vbNo
                    ' 仅标记不保存，不中断循环
                    IsToBeSaved = False
                Case vbCancel
                    ' 取消则返回表单并终止整个流程
                    UserParam.Show
                    Exit Sub
            End Select
        End If
        
        If IsToBeSaved Then
            swModelToExport.Extension.SaveAs3 finalName, 0, 1, Nothing, Nothing, nErrors, nWarnings
        End If
        
        'Close all the files
        swApp.CloseDoc ArrayList(i) & ".SLDPRT"
         
        'Reopen assembly
        Set swModel = swApp.OpenDoc6(PathInit, 1, 0, "", nStatus, nWarnings)                                                    'Open the model
        Set swModelActivated = swApp.ActivateDoc3(PathInit, False, swRebuildOnActivation_e.swUserDecision, nErrors)             'Activate the model
        Set swModelToExport = swApp.ActiveDoc                                                                                   'Get the activated model
    Next i
End Sub

修改说明 #

• 将文件名相关变量的计算逻辑移至循环内部，确保每次迭代都基于当前i生成正确的目标文件名。
• 选择「No」时，仅设置IsToBeSaved = False，移除UserParam.Show调用，避免中断循环，让代码继续处理下一个文件。
• 统一变量声明位置，明确变量类型，提升代码可读性和稳定性。
• 使用Select Case替代多个If判断，逻辑更清晰。

内容的提问来源于stack exchange，提问作者JetskiS