我有一个在 .accdb Access 数据库中执行宏的 VB.NET 程序。直到上周，它运行良好。直接在 Access 中运行时，宏执行良好，但三个宏中的两个在从 VB 程序执行时会生成此错误：
发生错误：System.Runtime.InteropServices.COMException (0x800A0BDB)：超出系统资源。在 Microsoft.Office.Interop.Access.DoCmd.RunMacro(Object MacroName, Object RepeatCount, Object RepeatExpression) 在 NicePrintMSAccessMacros.Module1.ExecuteMacros()
这是VB程序的日志输出：
2013 年 7 月 31 日下午 12:19:42 正在搜索 TEST 'RUN' 文件（\[删除服务器名称]\Apps\Macros_to_Run\Macros_to_Run_TEST.txt）...如果找到，应用程序将在 TEST 模式下继续。2013 年 7 月 31 日下午 12:19:42 发现 PRODUCTION 'RUN' 文件（\[服务器名称已删除]\Apps\Macros_to_Run\Macros_to_Run_TEST.txt）。继续生产模式。2013 年 7 月 31 日下午 12:19:42 开始运行 PRODUCTION 文件。2013 年 7 月 31 日下午 12:19:45 文件：\[服务器名称已删除]\Apps\My Labels\Labels\Labels.accdb 2013 年 7 月 31 日下午 12:19:45 正在寻找文件... 7/31 /2013 12:19:45 PM 找到文件。正在打开数据库... 2013 年 7 月 31 日下午 12:19:47 数据库打开。运行宏... 2013 年 7 月 31 日下午 12:19:47 运行宏 macCartItemLabels... 2013 年 7 月 31 日下午 12:20:13 发生错误：System.Runtime.InteropServices.COMException (0x800A0BDB)：超出系统资源。在微软。Office.Interop.Access.DoCmd.RunMacro(Object MacroName, Object RepeatCount, Object RepeatExpression) 在 NicePrintMSAccessMacros.Module1.ExecuteMacros() 7/31/2013 12:20:13 PM 检查今天数据库的备份... 7/31 /2013 下午 12:20:13 找到备份数据库 (\[删除服务器名称]\Apps\Macros_to_Run\DatabaseBackup\PROD\7-31-2013_BACKUP_Labels.accdb) 2013 年 7 月 31 日下午 12:20:13 生产模式已退出。2013 年 7 月 31 日下午 12:20:13 正在执行 30 天或更早的日志的例行清理... 2013 年 7 月 31 日下午 12:20:13 日志清理完成。13 PM 找到备份数据库 (\[删除服务器名称]\Apps\Macros_to_Run\DatabaseBackup\PROD\7-31-2013_BACKUP_Labels.accdb) 2013 年 7 月 31 日下午 12:20:13 退出生产模式。2013 年 7 月 31 日下午 12:20:13 正在执行 30 天或更早的日志的例行清理... 2013 年 7 月 31 日下午 12:20:13 日志清理完成。13 PM 找到备份数据库 (\[删除服务器名称]\Apps\Macros_to_Run\DatabaseBackup\PROD\7-31-2013_BACKUP_Labels.accdb) 2013 年 7 月 31 日下午 12:20:13 退出生产模式。2013 年 7 月 31 日下午 12:20:13 正在执行 30 天或更早的日志的例行清理... 2013 年 7 月 31 日下午 12:20:13 日志清理完成。
这是 Module1.vb 中的代码：
Imports Microsoft.Office.Interop
Module Module1
Dim MacrosFile As String
Dim Macros2RunFile As String = "\\[server name removed]\Apps\Macros_to_Run\Macros_to_Run_PROD.txt"
Dim Macros2RunFile_TEST As String = "\\[server name removed]\Apps\Macros_to_Run\Macros_to_Run_TEST.txt"
Dim logfile As String = "\\[server name removed]\Apps\Macros_to_Run\logs\log_" + Today.ToString.Remove(Today.ToString.IndexOf(" "), Today.ToString.Length - Today.ToString.IndexOf(" ")).Replace("/", "-") + ".log"
Dim DBbackupdirectory As String = "\\[server name removed]\Apps\Macros_to_Run\DatabaseBackup\"
Dim backupDB As String
Dim filedirectory As String = "\\[server name removed]\Apps\My Labels\Labels\"
Dim oAccess As Access.Application
Dim file As String
Sub Main()
Try
Log("Searching for TEST 'RUN' file (" + Macros2RunFile_TEST + ")... If found, the application will proceed in TEST mode.")
If My.Computer.FileSystem.FileExists(Macros2RunFile_TEST) Then
Log("TEST 'RUN' file (" + Macros2RunFile_TEST + ") found." + vbNewLine + vbTab + vbTab + vbTab + "Proceeding in TEST mode." + vbNewLine + vbTab + vbTab + vbTab + "Skipping search for PRODUCTION 'RUN' file (" + Macros2RunFile + ").")
file = "TEST_DB_Labels.accdb"
Log("Starting TEST file run.")
DBbackupdirectory = DBbackupdirectory + "TEST\"
MacrosFile = Macros2RunFile_TEST
ExecuteMacros()
createDBBackup()
Log("TEST mode exited.")
CleanLogFiles()
CleanBackupDatabases()
ElseIf My.Computer.FileSystem.FileExists(Macros2RunFile) Then
Log("PRODUCTION 'RUN' file (" + Macros2RunFile_TEST + ") found." + vbNewLine + vbTab + vbTab + vbTab + "Proceeding in PRODUCTION mode.")
file = "Labels.accdb"
Log("Starting PRODUCTION file run.")
DBbackupdirectory = DBbackupdirectory + "PROD\"
MacrosFile = Macros2RunFile
ExecuteMacros()
createDBBackup()
Log("PRODUCTION mode exited.")
CleanLogFiles()
CleanBackupDatabases()
Else
Log("The application is exiting because it cannot find either of the following:" + vbNewLine + "-" + Macros2RunFile_TEST + vbNewLine + "-" + Macros2RunFile)
End If
Catch ex As Exception
Log(ex.ToString + vbNewLine)
End
End Try
End Sub
Sub CleanLogFiles()
Try
Log("Executing routine cleanup of logs 30 days or older...")
Dim file_date As Date
Dim log_string As String
For Each log_file In My.Computer.FileSystem.GetFiles("\\[server name removed]\Apps\Macros_to_Run\logs\")
log_string = log_file.Remove(log_file.Length - 4, 4).Remove(0, 40).Replace("-", "/")
file_date = Convert.ToDateTime(log_string)
If file_date.AddDays(30) <= Today Then
My.Computer.FileSystem.DeleteFile(log_file)
Log(log_file + " has been deleted.")
End If
Next
Log("Log cleanup completed." + vbNewLine + vbNewLine)
Catch ex As Exception
Log(ex.ToString)
End Try
End Sub
Sub Log(ByVal text As String)
Try
My.Computer.FileSystem.WriteAllText(logfile, Now.ToString + vbTab + text + vbNewLine, True)
Catch ex As Exception
End Try
End Sub
Sub ExecuteMacros()
Try
Log("File: " + filedirectory + file)
oAccess = CreateObject("Access.Application")
'oAccess.Visible = False
Log("Looking for file...")
If My.Computer.FileSystem.FileExists(filedirectory + file) Then
Log("File found. Opening Database...")
oAccess.OpenCurrentDatabase(filedirectory + file, False)
Log("Database open. Running macro(s)...")
Dim lines() As String = System.IO.File.ReadAllLines(MacrosFile)
Dim i As Integer = 0
Do Until i > lines.Count - 1
Log("Running macro " + lines(i).ToString + "...")
oAccess.DoCmd.RunMacro(lines(i).ToString)
Log("Macro " + lines(i).ToString + " has completed.")
i += 1
Loop
Log("All macros specified have been run." + vbNewLine + vbTab + vbTab + vbTab + "Saving file on exit...")
oAccess.DoCmd().Quit(Microsoft.Office.Interop.Access.AcQuitOption.acQuitSaveAll)
Log("Exit complete.")
Else
Log("Could not find the file: " + filedirectory + file)
Try
Log("Attempting exiting of Microsoft Access without saving...")
oAccess.DoCmd().Quit(Microsoft.Office.Interop.Access.AcQuitOption.acQuitSaveNone)
Log("Exit complete.")
Catch ex As Exception
Log("Error occurred: " + ex.ToString)
End Try
End If
Log("Releasing InterOpServices Unmanaged COM Object...")
System.Runtime.InteropServices.Marshal.ReleaseComObject(oAccess)
oAccess = Nothing
Log("Release complete.")
'My.Computer.FileSystem.CopyFile(file, file.Replace("Labels.accdb", "Labels_BACKUP.accdb")) 'still a work in progress
Catch ex As Exception
Log("Error occurred: " + ex.ToString)
End Try
End Sub
Sub createDBBackup()
Try
Log("Checking for backup of today's database...")
backupDB = Today.ToString.Remove(Today.ToString.IndexOf(" "), Today.ToString.Length - Today.ToString.IndexOf(" ")).Replace("/", "-") + "_BACKUP_" + file
If My.Computer.FileSystem.FileExists(DBbackupdirectory + backupDB) Then
Log("Backup database found (" + DBbackupdirectory + backupDB + ")")
Else
Log("An existing backup of today's database was not found. Creating backup...")
My.Computer.FileSystem.CopyFile(filedirectory + file, DBbackupdirectory + backupDB)
Log("Backup has been created (" + DBbackupdirectory + backupDB + ")")
End If
Catch ex As Exception
Log("Error occurred: " + ex.ToString)
End Try
End Sub
Sub CleanBackupDatabases()
Try
Dim file_date As Date
Dim DB_string As String
For Each DB_file In My.Computer.FileSystem.GetFiles(DBbackupdirectory)
DB_string = DB_file.Remove(0, 51).Replace("-", "/")
DB_string = DB_string.Replace("_BACKUP_" + file, "")
file_date = Convert.ToDateTime(DB_string)
If file_date.AddDays(15) <= Today Then
My.Computer.FileSystem.DeleteFile(DB_file)
Log(DB_file + " has been deleted.")
End If
Next
Catch ex As Exception
Log("Error occurred: " + ex.ToString)
End Try
End Sub
End Module
任何帮助表示赞赏！另外，我还没有时间研究是否可以将其转换为简单的 .VBS 脚本，因此更改代码不需要 VS。关于如何执行在 VBS 脚本中执行 Access 数据库宏的相同任务的任何想法？
谢谢