学步园

        Friend gOfficeApplication As ApplicationEnum
        Protected gApplicationObject As Object

        Private gBeforeProcessStartTime As Date
        Private gAfterProcessStartTime As Date

        Private gServer As String = ""

        Friend Sub CreateInstance(ByVal officeApplication As ApplicationEnum, ByVal server As String)
            gOfficeApplication = officeApplication
            gServer = server
            CreateInstance()
        End Sub

        Private Sub CreateInstance()
            '保留原有配置
            SaveDefaultPropertiesWhenApplicationInitialize()

            '取实例前时间
            gBeforeProcessStartTime = Now

            '实例
            Select Case gOfficeApplication
                Case ApplicationEnum.Access
                    gApplicationObject = CreateObject(SR.GetString("Office_Application_Access"), gServer)
                Case ApplicationEnum.Excel
                    gApplicationObject = CreateObject(SR.GetString("Office_Application_Excel"), gServer)
                Case ApplicationEnum.Word
                    gApplicationObject = CreateObject(SR.GetString("Office_Application_Word"), gServer)
            End Select

            '取实例后时间
            gAfterProcessStartTime = Now
        End Sub

        ''' <summary>
        ''' 退出主进程
        ''' </summary>
        Public Sub Quit()
            '置回默认设置,如Excel.DisplayAlerts = True
            ResetDefaultPropertiesBeforeApplicationRelease()

            '释放其它对象,如Excel.Worksheets
            RealseInternalComObjectsBeforeApplicationRelease()

            '释放主进程,如Excel
            Application_Quit()

            '保证完全退出
            Try
                ApplicationRelease()
            Catch ex As Exception
            End Try
        End Sub

        ''' <summary>
        ''' 退出其它Com对象
        ''' </summary>
        Protected MustOverride Sub RealseInternalComObjectsBeforeApplicationRelease()

        Protected Overridable Sub Application_Quit()
            gApplicationObject.Quit()
        End Sub

        ''' <summary>
        ''' 退出OfficeApplication进程
        ''' </summary>
        Private Sub ApplicationRelease()
            ComObjReleaseMethod.ReleaseComObject(gApplicationObject)
            Select Case gOfficeApplication
                Case ApplicationEnum.Access
                    ComObjReleaseMethod.KillProcess(SR.GetString("Office_ProcessName_Access"), gBeforeProcessStartTime, gAfterProcessStartTime, gServer)
                Case ApplicationEnum.Excel
                    ComObjReleaseMethod.KillProcess(SR.GetString("Office_ProcessName_Excel"), gBeforeProcessStartTime, gAfterProcessStartTime, gServer)
                Case ApplicationEnum.Word
                    ComObjReleaseMethod.KillProcess(SR.GetString("Office_ProcessName_Word"), gBeforeProcessStartTime, gAfterProcessStartTime, gServer)
            End Select
        End Sub

        ''' <summary>
        ''' 保存默认设置
        ''' </summary>
        Protected MustOverride Sub SaveDefaultPropertiesWhenApplicationInitialize()

        ''' <summary>
        ''' 置回默认设置
        ''' </summary>
        Protected MustOverride Sub ResetDefaultPropertiesBeforeApplicationRelease()

        '///以下为实现IDisposable接口IDE自动创建的代码
        Private disposedValue As Boolean = False        ' To detect redundant calls

        ' IDisposable
        Protected Overridable Sub Dispose(ByVal disposing As Boolean)
            If Not Me.disposedValue Then
                If disposing Then
                    ' TODO: free unmanaged resources when explicitly called
                    Quit()
                End If

                ' TODO: free shared unmanaged resources
            End If
            Me.disposedValue = True
        End Sub

#Region " IDisposable Support "
        ' This code added by Visual Basic to correctly implement the disposable pattern.
        Public Sub Dispose() Implements IDisposable.Dispose
            ' Do not change this code.  Put cleanup code in Dispose(ByVal disposing As Boolean) above.
            Dispose(True)
            GC.SuppressFinalize(Me)
        End Sub
#End Region

    End Class
End Namespace

Namespace uOffice
    Partial Public Class ApplicationBase

        ''' <summary>
        ''' 设置对象可见性
        ''' </summary>
        ''' <param name="visible"></param>
        ''' <remarks></remarks>
        Public Sub SetVisible(ByVal visible As Boolean)
            Me.gApplicationObject.Visible = visible
        End Sub

        ''' <summary>
        ''' 服务器
        ''' </summary>
        ''' <remarks>本地时字符串为空,否则如//MyComputer</remarks>
        Public ReadOnly Property Server() As String
            Get
                Return gServer
            End Get
        End Property

        ''' <summary>
        ''' 版本号
        ''' </summary>
        Public ReadOnly Property Version() As String
            Get
                Return Me.gApplicationObject.Version
            End Get
        End Property

        ''' <summary>
        ''' 默认文件地址
        ''' </summary>
        ''' <remarks>一般在MyDocuments目录下,按具体情形重载</remarks>
        Public Overridable ReadOnly Property DefaultFilePath() As String
            Get
                Return System.Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)
            End Get
        End Property

        ''' <summary>
        ''' 稍停数秒
        ''' </summary>
        ''' <param name="seconds">秒数</param>
        ''' <remarks></remarks>
        Protected Sub WaitingSeconds(ByVal seconds As Integer)
            Dim tmpNow As Date = Now
            While Now.Subtract(tmpNow).Seconds < seconds
                Windows.Forms.Application.DoEvents()
            End While
        End Sub

    End Class
End Namespace

        Friend Shared Sub Invoke(ByVal comObj As Object, ByVal methodName As String, ByVal parameters() As Object)
            Dim mMethod As Reflection.MethodInfo = comObj.GetType.GetMethod(methodName)
            mMethod.Invoke(comObj, parameters)
        End Sub

        Friend Shared Sub ReleaseComObject(ByVal comObj As Object)
            System.Runtime.InteropServices.Marshal.ReleaseComObject(comObj)
            comObj = Nothing
        End Sub

        Friend Shared Sub KillProcess(ByVal comObjProcessName As String, ByVal beforeProcessStartTime As Date, ByVal afterProcessStartTime As Date)

            Dim mProcessList As Process()
            Dim mProcessStartTime As Date

            mProcessList = Process.GetProcessesByName(comObjProcessName)

            For Each tmpProcess As Process In mProcessList
                mProcessStartTime = tmpProcess.StartTime
                If mProcessStartTime.CompareTo(beforeProcessStartTime) > 0 AndAlso mProcessStartTime.CompareTo(afterProcessStartTime) < 0 Then
                    tmpProcess.Kill()
                End If
            Next

        End Sub

        Friend Shared Sub KillProcess(ByVal comObjProcessName As String, ByVal beforeProcessStartTime As Date, ByVal afterProcessStartTime As Date, ByVal Server As String)
            '暂只支持本地
            If Server = "" Then
                KillProcess(comObjProcessName, beforeProcessStartTime, afterProcessStartTime)
            Else

            End If

        End Sub

        Friend Shared Sub KillProcess(ByVal comObjProcessName As String)

            Dim mProcessList As Process()

            mProcessList = Process.GetProcessesByName(comObjProcessName)

            For Each tmpProcess As Process In mProcessList
                tmpProcess.Kill()
            Next

        End Sub

    End Class
End Namespace

        Protected Overrides Sub SaveDefaultPropertiesWhenApplicationInitialize()

        End Sub

        Protected Overrides Sub ResetDefaultPropertiesBeforeApplicationRelease()

        End Sub

        Protected Overrides Sub RealseInternalComObjectsBeforeApplicationRelease()

        End Sub

        Sub New()
            Me.CreateInstance(ApplicationEnum.Access, "")
        End Sub

        Sub New(ByVal server As String)
            Me.CreateInstance(ApplicationEnum.Access, server)
        End Sub

        Private Function CurrentApplication() As Microsoft.Office.Interop.Access.Application
            Return DirectCast(Me.gApplicationObject, Microsoft.Office.Interop.Access.Application)
            'Return Me.gApplicationObject
        End Function

    End Class
End Namespace

        ''' <summary>
        ''' 默认数据库路径
        ''' </summary>
        Public Overrides ReadOnly Property DefaultFilePath() As String
            Get
                '以下的字串是Default Database Directory
                Return Me.CurrentApplication.GetOption(SR.GetString("Office_Access_Default_Database_Directory")).ToString
            End Get
        End Property

        '取数据库文件全名
        Private Function FullFileName(ByVal file As String) As String
            Dim mFullfilename As String = file.Trim

            If mFullfilename = "" Then Return ""

            If mFullfilename.IndexOf("/") = -1 Then '默认目录上
                mFullfilename = Me.DefaultFilePath & mFullfilename
            End If

            Dim filename As String = mFullfilename.Substring(mFullfilename.LastIndexOf("/") + 1) '取文件名称,检查是否有后缀,没有加上.mdb
            If filename.IndexOf(".") = -1 Then
                mFullfilename &= ".mdb"
            End If

            Return mFullfilename
        End Function

    End Class
End Namespace

    Public Enum AcFileFormatEnum
        Access2 = 2
        Access2000 = 9
        Access2002 = 10
        Access95 = 7
        Access97 = 8
    End Enum

End Namespace

Namespace uOffice
    Partial Public Class AccessApplication

        ''' <summary>
        ''' 关闭当前数据库
        ''' </summary>
        Public Sub CloseCurrentDatabase()
            If Me.CurrentApplication.CurrentDb IsNot Nothing Then
                Me.CurrentApplication.CloseCurrentDatabase()
            End If

            '停1秒后执行
            WaitingSeconds(1)

        End Sub

        ''' <summary>
        ''' 删除数据库
        ''' </summary>
        ''' <param name="file">数据库文件名</param>
        Public Sub DeleteDatabase(ByVal file As String)
            file = FullFileName(file).ToLower

            If Not IO.File.Exists(file) Then Exit Sub

            '如果它是当前打开的数据库，则要关闭
            If Me.CurrentApplication.CurrentDb IsNot Nothing AndAlso IO.File.Equals(file, Me.CurrentApplication.CurrentDb.Name.ToLower) Then
                Me.CloseCurrentDatabase()
            End If

            IO.File.Delete(file)

            '停1秒后执行
            WaitingSeconds(1)
        End Sub

        ''' <summary>
        ''' 打开数据库
        ''' </summary>
        ''' <param name="file">数据库文件名</param>
        ''' <param name="exclusive">独占打开</param>
        ''' <param name="password">密码</param>
        ''' <remarks></remarks>
        Public Sub OpenCurrentDatabase(ByVal file As String, ByVal exclusive As Boolean, ByVal password As String)
            file = FullFileName(file)

            If Not IO.File.Exists(file) Then Exit Sub

            '关闭当前数据库
            CloseCurrentDatabase()

            Me.CurrentApplication.OpenCurrentDatabase(file, exclusive, password)

        End Sub

        ''' <summary>
        ''' 共享打开数据库，空密码
        ''' </summary>
        ''' <param name="file">数据库文件名</param>