VBA批量复制模板工作簿报错：运行时错误1004（网络路径场景）

原代码核心问题 #

• 模板文件路径不完整：Workbooks.Open(ThisWorkbook.Path & "\Template")未指定模板文件扩展名（如.xlsx），系统无法识别完整文件路径。
• 保存路径逻辑错误：SaveAs仅指定目标文件夹"\To_be_completed"，未拼接单元格中的文件名和扩展名，导致试图将文件保存到文件夹路径而非具体文件，触发路径错误。
• 循环逻辑混乱：第一次保存后，wb指向已保存的副本，后续循环会覆盖原有文件，Set wb = ActiveWorkbook属于冗余操作，加剧逻辑错误。

修正后的代码 #

Sub SaveTemplateworkbookAs()
    Dim wbTemplate As Workbook
    Dim rNames As Range, c As Range
    Dim targetFolder As String
    Dim templatePath As String
    
    ' 定义目标文件夹路径（匹配需求中的"To be completed"名称）
    targetFolder = ThisWorkbook.Path & "\To be completed\"
    ' 定义模板完整路径（根据实际文件类型调整扩展名，如.xlsm）
    templatePath = ThisWorkbook.Path & "\Template.xlsx"
    
    ' 获取CWs工作表中A列的名称列表
    Set rNames = ThisWorkbook.Worksheets("CWs").Range("A2", ThisWorkbook.Worksheets("CWs").Range("A2").End(xlDown))
    
    ' 循环处理每个名称
    For Each c In rNames
        ' 跳过空单元格，避免空值引发错误
        If Trim(c.Value) <> "" Then
            ' 打开模板工作簿
            Set wbTemplate = Workbooks.Open(templatePath)
            
            ' 将模板另存为指定文件夹下的新文件，文件名取自单元格值
            wbTemplate.SaveAs Filename:=targetFolder & c.Value & ".xlsx", _
                              FileFormat:=xlOpenXMLWorkbook, _
                              CreateBackup:=False
            
            ' 关闭已保存的副本，无需额外保存
            wbTemplate.Close SaveChanges:=False
        End If
    Next c
End Sub

关键修改说明 #

• 补全文件扩展名：模板路径和保存操作均添加.xlsx（若为宏工作簿，需改为.xlsm，同时将FileFormat改为xlOpenXMLWorkbookMacroEnabled）。
• 修正目标文件夹名称：将代码中误写的To_be_completed改为需求指定的To be completed。
• 优化循环逻辑：每次循环重新打开模板，避免覆盖已保存文件；添加空单元格判断，提升代码健壮性。
• 明确工作簿归属：使用ThisWorkbook.Worksheets("CWs")指定当前工作簿的工作表，避免激活其他工作簿时出错。

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