复制工作表至新工作簿时出现File not found错误求助

问题判断确认 #

你的判断完全正确：当Excel的CurDir指向**虚拟/受限的用户目录（如C:\Users<Name>）**时，创建新工作簿后复制工作表会触发"File not found"错误。原因是Excel在创建空白工作簿时会默认关联当前CurDir的临时存储，而受限虚拟目录不允许程序对其临时文件进行读写操作，导致工作表复制时无法访问必要的临时资源。

可行解决方案 #

核心思路是先将新建的空白工作簿保存到一个可读写的可靠路径，避免关联受限的CurDir，再执行工作表复制操作。推荐使用系统临时目录（通过Environ("TEMP")获取），这个路径几乎所有Windows环境都支持读写，且不会是虚拟受限位置。

修改后的代码示例 #

以下是调整后的完整代码，替换原逻辑中可能触发错误的部分：

Sub sys_PrepareToSend()
    Const csSource As String = "##.##"
    Const csFormat As String = ".xlsx"
    
    On Error GoTo ErrorCatch
    
    Dim strTarget As String
    Dim strTgtPth As String
    Dim wbkSource As Workbook
    Dim shtSource As Worksheet
    Dim wbkTarget As Workbook
    Dim shtTarget As Worksheet
    Dim strEndSht As String
    Dim shtEndSht As Worksheet
    Dim colExcess As New Collection
    Dim qryExcess As WorkbookQuery
    Dim conExcess As WorkbookConnection
    Dim rngValues As Range
    Dim blnSaved As Boolean
    Dim strOldFld As String
    Dim strTempPath As String ' 新增临时路径变量

    Dim i As Integer
    
    Call ess_SetUp
    
    Set wbkSource = ThisWorkbook
    ' 定义系统临时目录下的临时文件路径
    strTempPath = Environ("TEMP") & "\Temp_Target_Workbook.xlsx"
    
    ' 先创建并保存临时工作簿到可靠路径，避免关联受限CurDir
    Set wbkTarget = Workbooks.Add
    Application.DisplayAlerts = False ' 自动覆盖已存在的临时文件
    wbkTarget.SaveAs Filename:=strTempPath, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    
    Set shtEndSht = ThisWorkbook.ActiveSheet
    
    ' 标记新工作簿默认工作表为待删除（原逻辑保留）
    For Each shtTarget In wbkTarget.Sheets
        If shtTarget.Name Like csSource Then shtTarget.Name = shtTarget.Name & "_KillMe"
        colExcess.Add shtTarget
    Next shtTarget
    
    ' 复制工作表（此时已不会触发路径错误）
    For Each shtSource In wbkSource.Worksheets
        If shtSource.Name Like csSource Then
            
            shtSource.Copy after:=wbkTarget.Sheets(wbkTarget.Sheets.Count)
            
            Set shtTarget = wbkTarget.Sheets(shtSource.Name)
            If shtTarget.Name = Format(Date - 1, "MM.DD") Then Set shtEndSht = shtTarget
            On Error Resume Next
                Set rngValues = shtTarget.Cells.SpecialCells(xlCellTypeFormulas)
            On Error GoTo 0
            If Not rngValues Is Nothing Then
                rngValues.Value = rngValues.Value
            End If
        End If
    Next shtSource

    ' 后续可补充：删除标记的多余工作表、将最终文件保存到宏工作簿所在文件夹等逻辑
    ' ...

ErrorCatch:
    ' 错误处理：清理临时文件
    If Not wbkTarget Is Nothing Then
        Application.DisplayAlerts = False
        wbkTarget.Close SaveChanges:=False
        Application.DisplayAlerts = True
    End If
    On Error Resume Next
        Kill strTempPath ' 删除临时文件
    On Error GoTo 0
    MsgBox "错误：" & Err.Description, vbCritical
End Sub

额外说明 #

• 系统临时目录Environ("TEMP")返回的是当前用户的真实临时文件夹（如C:\Users<Name>\AppData\Local\Temp），具备完全读写权限，不会触发虚拟目录的限制。
• 如果需要最终将文件保存到宏工作簿所在文件夹，可在完成工作表处理后，使用wbkTarget.SaveAs指定目标路径，再删除临时文件。
• 代码中加入了临时文件清理逻辑，避免残留垃圾文件。

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