您的位置: 南阳信息港 > 生活

MSOffice小知识Access数据库的生成修理压缩和版本转换

发布时间:2019-11-05 22:02:04

在前面的基本框架中给出了代码下载。到现在,其中一些文件需要修改,主要的是考虑了远程对象的使用,就是CreateObject(Application,Server),加了Server。只是,现在给出的代码还是只是支持本地的。

修改后的有关文件如下:

ApplicationBase.vb

OptionStrictOff

NamespaceuOffice

PublicMustInheritClassApplicationBase

ImplementsIDisposable

FriendgOfficeApplicationAsApplicationEnum

ProtectedgApplicationObjectAsObject

PrivategBeforeProcessStartTimeAsDate

PrivategAfterProcessStartTimeAsDate

PrivategServerAsString=""

FriendSubCreateInstance(ByValofficeApplicationAsApplicationEnum,ByValserverAsString)

gOfficeApplication=officeApplication

gServer=server

CreateInstance()

EndSub

PrivateSubCreateInstance()

'保留原有配置

SaveDefaultPropertiesWhenApplicationInitialize()

'取实例前时间

gBeforeProcessStartTime=Now

'实例

SelectCasegOfficeApplication

CaseApplicationEnum.Access

gApplicationObject=CreateObject(SR.GetString("Office_Application_Access"),gServer)

CaseApplicationEnum.Excel

gApplicationObject=CreateObject(SR.GetString("Office_Application_Excel"),gServer)

CaseApplicationEnum.Word

gApplicationObject=CreateObject(SR.GetString("Office_Application_Word"),gServer)

EndSelect

'取实例后时间

gAfterProcessStartTime=Now

EndSub

'''<summary>

'''退出主进程

'''</summary>

PublicSubQuit()

'置回默认设置,如Excel.DisplayAlerts=True

ResetDefaultPropertiesBeforeApplicationRelease()

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

RealseInternalComObjectsBeforeApplicationRelease()

'释放主进程,如Excel

Application_Quit()

'保证完全退出

Try

ApplicationRelease()

CatchexAsException

EndTry

EndSub

'''<summary>

'''退出其它Com对象

'''</summary>

ProtectedMustOverrideSubRealseInternalComObjectsBeforeApplicationRelease()

ProtectedOverridableSubApplication_Quit()

gApplicationObject.Quit()

EndSub

'''<summary>

'''退出OfficeApplication进程

'''</summary>

PrivateSubApplicationRelease()

ComObjReleaseMethod.ReleaseComObject(gApplicationObject)

SelectCasegOfficeApplication

CaseApplicationEnum.Access

ComObjReleaseMethod.KillProcess(SR.GetString("Office_ProcessName_Access"),gBeforeProcessStartTime,gAfterProcessStartTime,gServer)

CaseApplicationEnum.Excel

ComObjReleaseMethod.KillProcess(SR.GetString("Office_ProcessName_Excel"),gBeforeProcessStartTime,gAfterProcessStartTime,gServer)

CaseApplicationEnum.Word

ComObjReleaseMethod.KillProcess(SR.GetString("Office_ProcessName_Word"),gBeforeProcessStartTime,gAfterProcessStartTime,gServer)

EndSelect

EndSub

'''<summary>

'''保存默认设置

'''</summary>

ProtectedMustOverrideSubSaveDefaultPropertiesWhenApplicationInitialize()

'''<summary>

'''置回默认设置

'''</summary>

ProtectedMustOverrideSubResetDefaultPropertiesBeforeApplicationRelease()

'///以下为实现IDisposable接口IDE自动创建的代码

PrivatedisposedValueAsBoolean=False'Todetectredundantcalls

'IDisposable

ProtectedOverridableSubDispose(ByValdisposingAsBoolean)

IfNotMe.disposedValueThen

IfdisposingThen

'TODO:freeunmanagedresourceswhenexplicitlycalled

Quit()

EndIf

'TODO:freesharedunmanagedresources

EndIf

Me.disposedValue=True

EndSub

#Region"IDisposableSupport"

'ThiscodeaddedbyVisualBasictocorrectlyimplementthedisposablepattern.

PublicSubDispose()ImplementsIDisposable.Dispose

'Donotchangethiscode.PutcleanupcodeinDispose(ByValdisposingAsBoolean)above.

Dispose(True)

GC.SuppressFinalize(Me)

EndSub

#EndRegion

EndClass

EndNamespace

ApplicationBaseCommon.vb

OptionStrictOff

NamespaceuOffice

PartialPublicClassApplicationBase

'''<summary>

'''设置对象可见性

'''</summary>

'''<paramname="visible"></param>

'''<remarks></remarks>

PublicSubSetVisible(ByValvisibleAsBoolean)

Me.gApplicationObject.Visible=visible

EndSub

'''<summary>

'''服务器

'''</summary>

'''<remarks>本地时字符串为空,否则如MyComputer</remarks>

PublicReadOnlyPropertyServer()AsString

Get

ReturngServer

EndGet

EndProperty

'''<summary>

'''版本号

'''</summary>

PublicReadOnlyPropertyVersion()AsString

Get

ReturnMe.gApplicationObject.Version

EndGet

EndProperty

'''<summary>

'''默认文件地址

'''</summary>

'''<remarks>一般在MyDocuments目录下,按具体情形重载</remarks>

PublicOverridableReadOnlyPropertyDefaultFilePath()AsString

Get

ReturnSystem.Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments)

EndGet

EndProperty

'''<summary>

'''稍停数秒

'''</summary>

'''<paramname="seconds">秒数</param>

'''<remarks></remarks>

ProtectedSubWaitingSeconds(ByValsecondsAsInteger)

DimtmpNowAsDate=Now

WhileNow.Subtract(tmpNow).Seconds<seconds

Windows.Forms.Application.DoEvents()

EndWhile

EndSub

EndClass

EndNamespace

ComObjReleaseMethod.vb

NamespaceuOffice

FriendClassComObjReleaseMethod

FriendSharedSubInvoke(ByValcomObjAsObject,ByValmethodNameAsString,ByValparameters()AsObject)

DimmMethodAsReflection.MethodInfo=comObj.GetType.GetMethod(methodName)

mMethod.Invoke(comObj,parameters)

EndSub

FriendSharedSubReleaseComObject(ByValcomObjAsObject)

System.Runtime.InteropServices.Marshal.ReleaseComObject(comObj)

comObj=Nothing

EndSub

FriendSharedSubKillProcess(ByValcomObjProcessNameAsString,ByValbeforeProcessStartTimeAsDate,ByValafterProcessStartTimeAsDate)

DimmProcessListAsProcess()

DimmProcessStartTimeAsDate

mProcessList=Process.GetProcessesByName(comObjProcessName)

ForEachtmpProcessAsProcessInmProcessList

mProcessStartTime=tmpProcess.StartTime

IfmProcessStartTime.CompareTo(beforeProcessStartTime)>0AndAlsomProcessStartTime.CompareTo(afterProcessStartTime)<0Then

tmpProcess.Kill()

EndIf

Next

EndSub

FriendSharedSubKillProcess(ByValcomObjProcessNameAsString,ByValbeforeProcessStartTimeAsDate,ByValafterProcessStartTimeAsDate,ByValServerAsString)

'暂只支持本地

IfServer=""Then

KillProcess(comObjProcessName,beforeProcessStartTime,afterProcessStartTime)

Else

EndIf

EndSub

FriendSharedSubKillProcess(ByValcomObjProcessNameAsString)

DimmProcessListAsProcess()

mProcessList=Process.GetProcessesByName(comObjProcessName)

ForEachtmpProcessAsProcessInmProcessList

tmpProcess.Kill()

Next

EndSub

EndClass

EndNamespace

相应的,有关的AccessApplication文件修改如下:

NamespaceuOffice

PublicClassAccessApplication

InheritsApplicationBase

ProtectedOverridesSubSaveDefaultPropertiesWhenApplicationInitialize()

EndSub

ProtectedOverridesSubResetDefaultPropertiesBeforeApplicationRelease()

EndSub

ProtectedOverridesSubRealseInternalComObjectsBeforeApplicationRelease()

EndSub

SubNew()

Me.CreateInstance(ApplicationEnum.Access,"")

EndSub

SubNew(ByValserverAsString)

Me.CreateInstance(ApplicationEnum.Access,server)

EndSub

PrivateFunctionCurrentApplication()AsMicrosoft.Office.Interop.Access.Application

ReturnDirectCast(Me.gApplicationObject,Microsoft.Office.Interop.Access.Application)

'ReturnMe.gApplicationObject

EndFunction

EndClass

EndNamespace

为实现Access数据库的生成、修理压缩和版本转换,增加了以下文件。

AccessApplicationCommon.vb

NamespaceuOffice

PartialPublicClassAccessApplication

'''<summary>

'''默认数据库路径

'''</summary>

PublicOverridesReadOnlyPropertyDefaultFilePath()AsString

Get

'以下的字串是DefaultDatabaseDirectory

ReturnMe.CurrentApplication.GetOption(SR.GetString("Office_Access_Default_Database_Directory")).ToString

EndGet

EndProperty

'取数据库文件全名

PrivateFunctionFullFileName(ByValfileAsString)AsString

DimmFullfilenameAsString=file.Trim

IfmFullfilename=""ThenReturn""

IfmFullfilename.IndexOf("")=-1Then'默认目录上

mFullfilename=Me.DefaultFilePath&mFullfilename

EndIf

DimfilenameAsString=mFullfilename.Substring(mFullfilename.LastIndexOf("")+1)'取文件名称,检查是否有后缀,没有加上.mdb

Iffilename.IndexOf(".")=-1Then

mFullfilename&=".mdb"

EndIf

ReturnmFullfilename

EndFunction

EndClass

EndNamespace

AcFileFormatEnum.vb

NamespaceuOffice

PublicEnumAcFileFormatEnum

Access2=2

Access2000=9

Access2002=10

Access95=7

Access97=8

EndEnum

EndNamespace

这部分功能实现的主文件

AccessApplicationDatabase.vb

OptionStrictOff

NamespaceuOffice

PartialPublicClassAccessApplication

'''<summary>

'''关闭当前数据库

'''</summary>

PublicSubCloseCurrentDatabase()

IfMe.CurrentApplication.CurrentDbIsNotNothingThen

Me.CurrentApplication.CloseCurrentDatabase()

EndIf

'停1秒后执行

WaitingSeconds(1)

EndSub

'''<summary>

'''删除数据库

'''</summary>

'''<paramname="file">数据库文件名</param>

PublicSubDeleteDatabase(ByValfileAsString)

file=FullFileName(file).ToLower

IfNotIO.File.Exists(file)ThenExitSub

'如果它是当前打开的数据库,则要关闭

IfMe.CurrentApplication.CurrentDbIsNotNothingAndAlsoIO.File.Equals(file,Me.CurrentApplication.CurrentDb.Name.ToLower)Then

Me.CloseCurrentDatabase()

EndIf

IO.File.Delete(file)

'停1秒后执行

WaitingSeconds(1)

EndSub

'''<summary>

'''打开数据库

'''</summary>

'''<paramname="file">数据库文件名</param>

'''<paramname="exclusive">独占打开</param>

'''<paramname="password">密码</param>

'''<remarks></remarks>

PublicSubOpenCurrentDatabase(ByValfileAsString,ByValexclusiveAsBoolean,ByValpasswordAsString)

file=FullFileName(file)

IfNotIO.File.Exists(file)ThenExitSub

'关闭当前数据库

CloseCurrentDatabase()

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

EndSub

'''<summary>

'''共享打开数据库,空密码

'''</summary>

'''<paramname="file">数据库文件名</param>

'''<remarks></remarks>

PublicSubOpenCurrentDatabase(ByValfileAsString)

Me.OpenCurrentDatabase(file,False,"")

EndSub

'''<summary>

'''创建数据库

'''</summary>

'''<paramname="file">数据库文件名.如果网络支持,也可以按以下形式指定网络路径:ServerShareFolderFilename</param>

'''<remarks>若已存在相同文件的数据库,则被删除</remarks>

PublicSubCreateDatabase(ByValfileAsString)

file=FullFileName(file).ToLower

'若已存在,则删除

DeleteDatabase(file)

'关闭当前数据库

Me.CloseCurrentDatabase()

'生成新数据库并给置为当前数据库

Me.CurrentApplication.NewCurrentDatabase(file)

EndSub

'''<summary>

'''压缩和修复指定的数据库

'''</summary>

'''<paramname="SourceFile">要压缩和修复的数据库或项目文件的完整路径和文件名</param>

'''<paramname="DestinationFile">完整的路径和文件名,代表所返回文件的保存位置</param>

'''<returns>如果处理成功,返回True</returns>

'''<remarks></remarks>

PublicFunctionRepairDatabase(ByValSourceFileAsString,ByValDestinationFileAsString)AsBoolean

SourceFile=FullFileName(SourceFile)

DestinationFile=FullFileName(DestinationFile)

'如果要处理的数据库为当前打开的数据库,则要关闭

IfMe.CurrentApplication.CurrentDbIsNotNothingAndAlsoMe.CurrentApplication.CurrentDb.Name.ToLower.Equals(SourceFile.ToLower)Then

Me.CloseCurrentDatabase()

EndIf

'如果目的文件存在,则删除

IfIO.File.Exists(DestinationFile)ThenIO.File.Delete(DestinationFile)

'滞1秒后执行

WaitingSeconds(1)

ReturnMe.CurrentApplication.CompactRepair(SourceFile,DestinationFile,True)

EndFunction

'''<summary>

'''转换版本

'''</summary>

'''<paramname="SourceFile">待转换的文件名称</param>

'''<paramname="DestinationFile">转换后的文件名称</param>

'''<paramname="DestinationFileFormat">转换后的文件版本</param>

'''<remarks>并非所有版本都能转换成功</remarks>

PublicSubConvertAccessProject(ByValSourceFileAsString,ByValDestinationFileAsString,ByValDestinationFileFormatAsAcFileFormatEnum)

SourceFile=FullFileName(SourceFile)

DestinationFile=FullFileName(DestinationFile)

Me.CurrentApplication.ConvertAccessProject(SourceFile,DestinationFile,DestinationFileFormat)

EndSub

EndClass

EndNamespace

至于其它功能,比如设密码、建用户组,可以参考Access、Dao的帮助文档,并辅以Reflector来做。我不再写这部分的代码了。

至于一些关键参数,比如Default Database Directory是怎么知道的,我是查了注册表。我手头的资料也非常的有限。

对于Access,如何取表,建立和修改表,这部分可以用Sql语句实现了,可以脱离Access.Application来做。当然,上面的部分,可以用别的方法来实现,我只是提供了在Access环境下的一种实现方法。

【近视激光患者注意】SMILE全飞秒激光近视术后需知道的事项
眉毛种植后,会不会长很长?答案在里面,戳一下告诉你
听说嚼口香糖能清新口气?你看到的只是表面
眼部整形手术
眉毛太稀怎么办
猜你会喜欢的
猜你会喜欢的