使用VBA代码保存Excel文件至硬盘时出现Error 1004问题求助

常见原因及修复方案 #

1. 路径不存在或权限不足 #

• 先确认h:\aaa\bb\路径真实存在，手动打开该目录验证；若不存在，可通过VBA自动创建：

  Dim fso As Object
  Set fso = CreateObject("Scripting.FileSystemObject")
  If Not fso.FolderExists("h:\aaa\bb") Then
      fso.CreateFolder "h:\aaa\bb"
  End If
  Set fso = Nothing
  

• 检查当前用户对目标目录是否有写入权限，右键目录→属性→安全选项卡确认权限配置。

2. 文件格式与扩展名不匹配 #

用户保存的是.xls格式，但默认新建工作簿为Excel现代格式（如.xlsx），SaveAs时需指定对应格式参数：

• 若使用后期绑定（未引用Excel库），用数值常量指定格式：

  objwkb.SaveAs Filename:="h:\aaa\bb\output.xls", FileFormat:=56 ' 56对应Excel 97-2003格式
  

• 若已引用Excel库，可直接用枚举值：

  objwkb.SaveAs Filename:="h:\aaa\bb\output.xls", FileFormat:=xlExcel8
  

3. 文件被占用或只读 #

• 确认output.xls未被其他程序打开，打开任务管理器结束所有Excel后台进程后重试。
• 若目标文件已存在且设为只读，先修改属性并删除：

  If Dir("h:\aaa\bb\output.xls") <> "" Then
      SetAttr "h:\aaa\bb\output.xls", vbNormal
      Kill "h:\aaa\bb\output.xls"
  End If
  

4. 整合修复后的完整代码 #

Set rs = CurrentDb.OpenRecordset("dynamic_query", OpenSnapshot)

Set objxl = CreateObject("Excel.Application")
Set objwkb = objxl.Workbooks.Add

' 写入查询数据
With objwkb.Worksheets(1)
    .Cells(1, 1).CopyFromRecordset rs
End With

Dim savePath As String
savePath = "h:\aaa\bb\output.xls"

' 确保保存目录存在
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(fso.GetParentFolderName(savePath)) Then
    fso.CreateFolder fso.GetParentFolderName(savePath)
End If
Set fso = Nothing

' 清理已存在的目标文件
If Dir(savePath) <> "" Then
    SetAttr savePath, vbNormal
    Kill savePath
End If

' 带格式参数保存
objwkb.SaveAs Filename:=savePath, FileFormat:=56

' 正确释放对象
objxl.Quit
Set objwkb = Nothing
Set objxl = Nothing
Set rs = Nothing

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