为什么我的 Access 数据库对象变量在读取其模块容器的过程中失去了与其源文件的连接？

问题描述

我们使用 VBA 工具从 Access 应用程序中提取模块、表单和报告，并为用户创建可执行文件。直到最近，该工具一直运行没有任何问题。但是，当我使用它从几个应用程序中提取时，我不断遇到“自动化错误（远程过程调用失败）”错误。但是，我的同事（在几乎相同的构建中运行相同的代码）能够正常运行。

这是在 Win10 Pro (v2004 - 19041.685)、Office 2016 Pro Plus (16.0.4266.1001) 上运行的。我相信我同事的机器应该是一样的，因为我们刚刚搬到这些笔记本电脑上。

这是核心代码：

Public Sub ExportAll()

    On Error GoTo ErrorProc
    Dim oAccessApp As Access.Application
    Dim odoc As Document
    Dim sFilePath As String
    Dim oDb As Database
    Dim fso As FileSystemObject
    Dim strFile As String
    Dim strFolder As String
    strFile = "accdb path"
    strFolder = oApp.GetFolder(strFile)
    Set oAccessApp = oApp.OpenDatabase(strFile)
    Set oDb = oAccessApp.CurrentDb
    Set fso = New FileSystemObject
    
    If Not fso.FolderExists((strFolder) & "\SCC") Then
        fso.CreateFolder strFolder & "\SCC"
    End If
    
    If Not fso.FolderExists(strFolder & "\SCC\Modules") Then
        fso.CreateFolder strFolder & "\SCC\Modules"
    End If
    
    If Not fso.FolderExists(strFolder & "\SCC\Forms") Then
        fso.CreateFolder strFolder & "\SCC\Forms"
    End If
    
    If Not fso.FolderExists(strFolder & "\SCC\Reports") Then
        fso.CreateFolder strFolder & "\SCC\Reports"
    End If
        
    For Each odoc In oDb.Containers("Modules").Documents
        DoEvents
        sFilePath = strFolder & "\SCC\Modules\" & odoc.Name & ".bas.txt"
        oAccessApp.SaveAsText acModule,odoc.Name,sFilePath
    Next
    
    For Each odoc In oDb.Containers("Forms").Documents
        DoEvents
        sFilePath = strFolder & "\SCC\Forms\" & odoc.Name & ".frm.txt"
        oAccessApp.SaveAsText acForm,sFilePath
    Next
    
    For Each odoc In oDb.Containers("Reports").Documents
        DoEvents
        sFilePath = strFolder & "\SCC\Reports\" & odoc.Name & ".rpt.txt"
        oAccessApp.SaveAsText acReport,sFilePath
    Next
    
    oDb.Close
    Set oDb = nothing
    oAccessApp.Quit
    Set oAccessApp = nothing
    Exit Sub
ErrorProc:
    If Not (oAccessApp Is nothing) Then
        oAccessApp.Quit
    End If
    Set oAccessApp = nothing
    MsgBox Err.Description,vbExclamation,"Error " & Err.Number
End Sub

在提取过程中，被提取的数据库应始终保持打开状态。每个失败都发生在 For Each odoc In oDb.Containers("Modules").Documents 循环中，并且在 odoc 变量引用特定模块时发生。当我逐步通过并到达有问题的模块时，一切都很好，直到遇到 odoc.Name 行，此时数据库关闭并且对象 oDb 的所有消息都显示为“”。

导致问题的模块如下：

Option Compare Database
Option Explicit

'
' Opens file using default program
'  (.xls files open in Excel,.doc files open in Word,etc)
'


'Code Courtesy of
'Dev Ashish

#If Win64 Then
    Private Declare PtrSafe Function apiShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
        ByVal hWnd As LongPtr,ByVal lpOperation As String,ByVal lpFile As String,_
        ByVal lpParameters As String,ByVal lpDirectory As String,ByVal nShowCmd As Long) As LongPtr
#Else
    Private Declare Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long,_
    ByVal lpOperation As String,_
    ByVal lpFile As String,_
    ByVal lpParameters As String,_
    ByVal lpDirectory As String,_
    ByVal nShowCmd As Long) _
    As Long
#End If


Public Enum ShellExecuteWinStyle
    WIN_norMAL = 1         'Open normal
    WIN_MAX = 2            'Open Maximized
    WIN_MIN = 3            'Open Minimized
End Enum


Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

'
' Opens file using default program
'  (.xls files open in Excel,etc)
'
Function ShellExecute(strFile As Variant,lShowHow As ShellExecuteWinStyle)
    #If Win64 Then
        Dim lRet As LongPtr
    #Else
        Dim lRet As Long
    #End If
        
    Dim varTaskID As Variant
    Dim stRet As String
    Dim stFile As String

    If IsNull(strFile) Or strFile = "" Then Exit Function
    
    stFile = strFile
    
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp,vbNullString,_
            stFile,lShowHow)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile,WIN_norMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    ShellExecute = lRet & _
                IIf(stRet = "","," & stRet)
End Function

我尝试了以下方法：

移除问题模块（过程成功完成）
重命名模块
删除支持编译的条件语句
将提取代码移至新数据库
从数据库中提取只有问题模块加上带有注释的模块
修复微软办公室
重新安装 MS Office
降级 Windows 更新

有谁知道为什么这可能会失败？任何关于如何纠正的建议将不胜感激。

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

ms-access ms-access-2016 vba