ExcelHome技术论坛

标题: Excel 压缩ACCESS2007 accdb格式数据库 [打印本页]
作者: dul    时间: 2009-12-8 10:48
标题: Excel 压缩ACCESS2007 accdb格式数据库
方法1：

该方法将ACCESS2007 accdb格式压缩并转换为：ACCESS97-2003 mdb格式 后缀名仍为：accdb


  3. Function RunTest()
  4.     CompactDatabse2007JRO CurrentProject.Path & "\a.accdb ", _
  5.                           CurrentProject.Path & "\b.accdb "
  6. End Function
  7. Function CompactDatabse2007JRO(ByVal SourceAccdb As String, _
  8.                                ByVal TargetAccdb As String) As Boolean
  9.     On Error Resume Next
  10.     Dim JRO As JRO.JetEngine
  11.     Set JRO = New JRO.JetEngine
  12.     Dim strS As String
  13.     Dim strT As String
  14.     strS = "Provider=Microsoft.ACE.OLEDB.12.0;User   ID=Admin;Data   Source= " & SourceAccdb
  15.     strT = "Provider=Microsoft.ACE.OLEDB.12.0;User   ID=Admin;Data   Source= " & TargetAccdb & ";Jet   OLEDB:Engine   Type=5 "
  16.     JRO.CompactDatabase strS, strT
  17.     If Err <> 0 Then
  18.         CompactDatabse2007JRO = False
  19.         Debug.Print Err.Number, Err.Description
  20.         Err.Clear
  21.     Else
  22.         CompactDatabse2007JRO = True
  23.     End If
  24. End Function

复制代码

[ 本帖最后由 dul 于 2009-12-8 10:54 编辑 ]
作者: dul    时间: 2009-12-8 10:53
方法2:
该方法将ACCESS2007 accdb格式不变的状况进行压缩



  3. Public Sub CompactJetDatabase(Location As String, _
  4.                               Optional BackupOriginal As Boolean = True)
  5.    
  6.     On Error GoTo CompactErr

  8.     Dim strBackupFile As String
  9.     Dim strTempFile   As String
  10.     '检查数据库文件是否存在
  11.     If Len(Dir(Location)) Then
  12.         '如果需要备份就执行备份
  13.         If BackupOriginal = True Then
  14.             strBackupFile = GetTemporaryPath & "backup.accdb"
  15.             If Len(Dir(strBackupFile)) Then Kill strBackupFile
  16.             FileCopy Location, strBackupFile
  17.         End If
  18.         '创建临时文件名
  19.         strTempFile = GetTemporaryPath & "temp.accdb"
  20.         If Len(Dir(strTempFile)) Then Kill strTempFile
  21.         '通过DBEngine压缩数据库文件
  22.         DBEngine.CompactDatabase Location, strTempFile
  23.         '删除原来的数据库文件
  24.         Kill Location
  25.         '拷贝刚刚压缩过临时数据库文件至原来位置
  26.         FileCopy strTempFile, Location
  27.         '删除临时文件
  28.         Kill strTempFile
  29.     Else
  30.     End If
  31. CompactErr:
  32.     Exit Sub
  33. End Sub
  34. Public Function GetTemporaryPath()
  35.     Dim strFolder As String
  36.     Dim lngResult As Long
  37.     strFolder = String(MAX_PATH, 0)
  38.     lngResult = GetTempPath(MAX_PATH, strFolder)
  39.     If lngResult <> 0 Then
  40.         GetTemporaryPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
  41.     Else
  42.         GetTemporaryPath = ""
  43.     End If
  44. End Function

复制代码
作者: dul    时间: 2009-12-8 10:58
标题: 前提：
1。工程引用：
作者: dul    时间: 2009-12-8 11:05
标题: 前提：
2。必须：
完整安装office ACCESS2007 或 安装以下ACCESS2007的连接驱动：
http://www.microsoft.com/downloa ... 8-9b72-ef94e038c891

连接数据库的方式已经不在是：
“provider=microsoft.jet.oledb.4.0;data source=。。。。”
新的连接方式为：
“Provider=Microsoft.ACE.OLEDB.12.0;Data Source=。。。”
作者: qsdys    时间: 2010-4-22 11:02
程序中正在用到这个，学习了，谢谢
作者: liucqa    时间: 2012-2-13 22:38
学习         
作者: yuk_yu    时间: 2012-3-12 15:25
dul 发表于 2009-12-8 11:05
2。必须：
完整安装office ACCESS2007 或 安装以下ACCESS2007的连接驱动：
http://www.microsoft.com/dow ...

学习，留着备用......
作者: wsp1478714    时间: 2012-8-20 23:06
学习，留着慢慢理解
作者: hongtao_bmc    时间: 2012-12-24 21:49

学习，留着慢慢理解
作者: 648555205    时间: 2017-11-17 19:36
学习，在Excel里也测试有效，谢谢



欢迎光临 ExcelHome技术论坛 (https://club.excelhome.net/) Powered by Discuz! X3.4