Win7升级Win11后VBA-Access年度账套创建异常求助

问题根源推测 #

从Win7迁移到Win11后，用CreateObject("Access.Application")新建的数据库出现引用缺失及未知异常，主要是因为：

• Win11下Office 365的组件引用路径、默认注册组件和Win7环境存在差异，新建数据库无法自动继承原程序的必要引用
• Win11的文件权限、Office信任设置更严格，导致新建数据库的运行环境受限

两种可行解决办法 #

办法一：修复自动创建流程的引用同步 #

在新建数据库后，手动同步原数据库的有效引用，避免缺失：

fileName = CHEMIN_SAUVEGARDE_COMPTE & "FFcompte " & year & ".accdb"
Set appAccess = CreateObject("Access.Application")
appAccess.NewCurrentDatabase fileName

' 同步原数据库的正常引用
Dim ref As Reference
Dim originalDb As Database
Set originalDb = CurrentDb
For Each ref In originalDb.References
    If Not ref.IsBroken Then
        On Error Resume Next ' 跳过已存在的引用
        appAccess.References.AddFromFile ref.FullPath
        On Error GoTo 0
    End If
Next ref

' 后续继续执行填充表、查询等逻辑

另外，Win11下部分ActiveX组件可能未默认注册，新建数据库后需手动检查并启用必要组件（比如MS Office数据访问组件）。

办法二：改用「复制原库+清理冗余」的方式（更稳定） #

直接复制原数据库再删除不需要的对象，能彻底规避新建库的环境适配问题：

1. 复制原数据库并重命名：

Dim originalPath As String
Dim targetPath As String
originalPath = CurrentDb.Name ' 获取当前原数据库路径
targetPath = CHEMIN_SAUVEGARDE_COMPTE & "FFcompte " & year & ".accdb"

' 复制文件到目标路径
FileCopy originalPath, targetPath

2. 打开复制后的数据库，删除非账务相关对象：

Set appAccess = CreateObject("Access.Application")
appAccess.OpenCurrentDatabase targetPath

' 删除非账务表（假设账务表前缀为"Acc_"，跳过系统表）
Dim tbl As TableDef
For Each tbl In appAccess.CurrentDb.TableDefs
    If Left(tbl.Name, 4) <> "Acc_" And tbl.Name Not Like "MSys*" Then
        appAccess.DoCmd.DeleteObject acTable, tbl.Name
    End If
Next tbl

' 删除非账务窗体
Dim obj As AccessObject
For Each obj In appAccess.CurrentProject.AllForms
    If Left(obj.Name, 4) <> "Acc_" Then
        appAccess.DoCmd.DeleteObject acForm, obj.Name
    End If
Next obj

' 同理处理查询、报表、模块（注意保留账务相关的模块/类模块）

3. 压缩修复数据库，优化体积：

appAccess.CompactRepair targetPath, targetPath & "_temp.accdb"
Kill targetPath
Name targetPath & "_temp.accdb" As targetPath
appAccess.CloseCurrentDatabase

额外提醒 #

• 确保目标文件夹CHEMIN_SAUVEGARDE_COMPTE在Win11下有读写权限，避免文件操作失败
• 清理完成后，记得添加年份过滤逻辑，确保新库只保留当年账务数据

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