VB.Net互操作错误0x800A0BDB

VB.Net互操作错误0x800A0BDB,vb.net,office-interop,Vb.net,Office Interop,我有一个VB.NET程序,它在.accdb Access数据库中执行宏。直到上周,它一直运作良好。直接在Access中运行时,宏可以正常执行,但从VB程序执行时,三个宏中的两个会生成此错误: 发生错误:System.Runtime.InteropServices.COMException(0x800A0BDB):超出系统资源。 在Microsoft.Office.Interop.Access.DoCmd.RunMacro(对象宏名、对象重复计数、对象重复表达式) 在NicePrintMSAcce

我有一个VB.NET程序,它在.accdb Access数据库中执行宏。直到上周,它一直运作良好。直接在Access中运行时,宏可以正常执行,但从VB程序执行时,三个宏中的两个会生成此错误:

发生错误:System.Runtime.InteropServices.COMException(0x800A0BDB):超出系统资源。 在Microsoft.Office.Interop.Access.DoCmd.RunMacro(对象宏名、对象重复计数、对象重复表达式) 在NicePrintMSAccessMacros.Module1.ExecuteMacros()处

以下是VB程序的日志输出:

2013年7月31日下午12:19:42搜索测试“运行”文件(\[服务器名称已删除]\Apps\Macros\u to\u RUN\Macros\u to\u RUN\u TEST.txt)。。。如果找到,应用程序将在测试模式下继续。 2013年7月31日12:19:42下午找到生产“运行”文件(\[服务器名称已删除]\Apps\Macros\u to\u RUN\Macros\u to\u RUN\u TEST.txt)。 以生产模式进行。 2013年7月31日12:19:42开始生产文件运行。 2013年7月31日12:19:45下午文件:\[服务器名称已删除]\Apps\My Labels\Labels\Labels.accdb 2013年7月31日下午12:19:45查找文件。。。 2013年7月31日12:19:45找到文件。正在打开数据库。。。 2013年7月31日12:19:47下午数据库打开。正在运行宏。。。 2013年7月31日下午12:19:47运行宏macCartItemLabels。。。 2013年7月31日12:20:13下午发生错误:System.Runtime.InteropServices.COMException(0x800A0BDB):超出系统资源。 在Microsoft.Office.Interop.Access.DoCmd.RunMacro(对象宏名、对象重复计数、对象重复表达式) 在NicePrintMSAccessMacros.Module1.ExecuteMacros()处 2013年7月31日下午12:20:13检查当前数据库的备份。。。 2013年7月31日12:20:13找到备份数据库(\[服务器名称已删除]\Apps\Macros\u to\u Run\DatabaseBackup\PROD\7-31-2013\u Backup\u 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
导入Microsoft.Office.Interop
模块1
将宏文件设置为字符串
Dim Macros2RunFile As String=“\\[服务器名称已删除]\Apps\Macros\u to\u Run\Macros\u to\u Run\u PROD.txt”
Dim MACROS2RUNFLE\U TEST As String=“\\[服务器名称已删除]\Apps\Macros\u to\u Run\Macros\u to\u Run\u TEST.txt”
Dim logfile As String=“\\[server name removed]\Apps\Macros\u to\u Run\logs\log”+Today.ToString.Remove(Today.ToString.IndexOf(“”),Today.ToString.Length-Today.ToString.IndexOf(“”)。替换(“/”,“-”+”).log”
Dim DBbackupdirectory As String=“\\[服务器名称已删除]\Apps\Macros\u to\u Run\DatabaseBackup\”
作为字符串的Dim backupDB
Dim filedirectory As String=“\\[服务器名称已删除]\Apps\My Labels\Labels\”
将OAAccess设置为Access.Application
将文件设置为字符串
副标题()
尝试
日志(“搜索测试‘运行’文件(“+Macros2RunFile_TEST+”))。如果找到,应用程序将在测试模式下继续。”)
如果My.Computer.FileSystem.files存在(Macros2RunFile\u TEST),则
日志(“找到测试“运行”文件(“+Macros2RunFile_TEST+”)。“+vbNewLine+vbTab+vbTab+vbTab+”在测试模式下继续。”+vbNewLine+vbTab+vbTab+vbTab+”跳过对生产“运行”文件的搜索(“+Macros2RunFile+”))
file=“TEST\u DB\u Labels.accdb”
日志(“正在启动测试文件运行”)
DBbackupdirectory=DBbackupdirectory+“TEST\”
宏文件=宏2不匹配\u测试
行政长官
createDBBackup()
日志(“测试模式已退出”)
CleanLogFiles()
cleanbackupdatebases()
如果My.Computer.FileSystem.FileExists(Macros2RunFile)存在,则
日志(“找到生产“运行”文件(“+Macros2RunFile_TEST+”)。“+vbNewLine+vbTab+vbTab+vbTab+”在生产模式下继续。”)
file=“Labels.accdb”
日志(“正在启动生产文件运行”)
DBbackupdirectory=DBbackupdirectory+“PROD\”
MacrosFile=Macros2RunFile
行政长官
createDBBackup()
日志(“生产模式已退出”)
CleanLogFiles()
cleanbackupdatebases()
其他的
日志(“应用程序正在退出,因为它找不到以下任何一项:“+vbNewLine+”-“+Macros2RunFile_TEST+vbNewLine+”-“+Macros2RunFile”)
如果结束
特例
日志(例如ToString+vbNewLine)
终点
结束尝试
端接头
子日志文件()
尝试
日志(“执行30天或30天以上日志的例行清理…”)
Dim文件\u日期为日期
Dim log_字符串作为字符串
对于My.Computer.FileSystem.GetFiles中的每个日志文件(“\\[服务器名称已删除]\Apps\Macros\u to\u Run\logs\”)
log\u string=log\u file.Remove(log\u file.Length-4,4)。Remove(0,40)。Replace(“-”,“/”)
文件日期=Convert.ToDateTime(日志字符串)

如果文件_date.AddDays(30),日志的可能副本表明运行此宏时出错:NicePrintMSAccessMacros.Module1.ExecuteMacros()由于宏不可用,很难告诉您该怎么做。我不确定如何向您提供宏,或者它是否有助于这样做,因为从Microsoft Access内部手动提交时宏运行正常。此外,该问题在午夜、凌晨2点、凌晨4点和早上8点继续出现。但是,它在今天早上6点的运行中成功地完成了所有三个宏。还有什么正在运行,或者您是否可能为该数据库打开了导致系统资源耗尽的对象。宏的执行是否因数据大小大而不同?很可能有用户通过NiceLabel程序访问数据库(该程序将查询数据库中的数据)。这会不会引起一些麻烦