如何解决为什么我的 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 举报,一经查实,本站将立刻删除。