Access VBA通过TransferSpreadsheet生成多Excel工作表失效问题求助

看起来微软的Office更新确实改变了TransferSpreadsheet在导出到旧Excel格式（acSpreadsheetTypeExcel8，即xls格式）时的默认行为——旧版本中如果目标文件已存在且指定的工作表名重复，Access会自动创建带序号的新工作表（比如Query1、Query1(1)），但现在它会直接覆盖已有的同名工作表，这就是你只看到最后一个工作表的原因。

下面给你两个可行的解决方案，优先推荐第一个，简单直接：

方案1：使用唯一的工作表名称（最简便） #

你的循环每次处理不同的年月数据，刚好可以用年份+月份作为唯一的工作表名称，这样每次导出都会创建新表，不会覆盖。修改代码的步骤如下：

1. 在循环内、TransferSpreadsheet命令之前，添加一行生成唯一表名的代码：

   ' 生成类似"2024_05"的唯一工作表名称
   strSheetName = tempyr & "_" & tempMth
   

2. 修改TransferSpreadsheet的最后一个参数，把原来的strTemp替换成这个唯一名称：

   DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, strTemp, SpLocation, True, strSheetName
   

这样每次导出的工作表名称都是独一无二的，自然不会出现覆盖问题，完全适配现在的Office行为。

方案2：通过Excel对象模型显式控制（更灵活） #

如果需要对工作表的位置、格式等做更多控制，可以直接操作Excel对象，先确保新工作表存在再导出数据：

Dim objExcel As Object
Dim objWB As Object
Dim fileExists As Boolean

' 检查目标Excel文件是否已经存在
fileExists = Dir(SpLocation) <> ""

If fileExists Then
    ' 文件已存在，打开Excel并新增工作表
    Set objExcel = CreateObject("Excel.Application")
    Set objWB = objExcel.Workbooks.Open(SpLocation)
    ' 在现有工作表的最后新增一张表，用年月命名
    objWB.Sheets.Add(After:=objWB.Sheets(objWB.Sheets.Count)).Name = tempyr & "_" & tempMth
    objWB.Save
    objWB.Close
    objExcel.Quit
    ' 释放对象
    Set objWB = Nothing
    Set objExcel = Nothing
End If

' 导出查询数据到指定的新工作表
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, strTemp, SpLocation, True, tempyr & "_" & tempMth

这个方法完全绕过了TransferSpreadsheet的默认覆盖逻辑，手动控制工作表的创建，兼容性更强。

额外建议 #

• 考虑把导出格式升级为xlsx（对应acSpreadsheetTypeExcel12Xml），新格式的行为更稳定，也更适配现代Office版本，减少类似更新导致的兼容性问题。
• 确保生成的工作表名称符合Excel规则：不能包含/:*?"<>|这些字符，长度不超过31位。

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