纯编码如何实现Access数据库的建立或压缩（2）

会计考友

Set Ca = Nothing 　　CreateDBfile = True
　　End If
　　End function
　　Public function CompactDatabase(byVal dbFileName,byVal DbVer,byVal SavePath)
: ?! B: q; ^3 V　　’压缩数据库文件
4 F: L$ @! i( F) T' @1 _　　’0 为access 97
　　’1 为access 2000
1 h2 c2 P) O2 c# e4 h　　On Error resume next
, p2 ~, c! z2 J( H, T. o7 X　　If Right(SavePath,1)"\" Or Right(SavePath,1)"/" Then SavePath = Trim(SavePath) & "\"
　　If Left(dbFileName,1)="\" Or Left(dbFileName,1)="/" Then dbFileName = Trim(Mid(dbFileName,2,Len(dbFileName)))
" h! x5 b3 ~& M& l& M% j　　If DbExists(SavePath & dbFileName) Then
　　Response.Write ("对不起，该数据库已经存在!")
! c) q) K" `- G1 d; @/ s" r　　CompactDatabase = False
0 w6 R! {5 M" K* F, _$ W　　Else
　　Dim Cd
　　Set Cd =Server.CreateObject("JRO.JetEngine")

/ k& p6 [5 {: `6 U3 V- j　　If Err.number0 Then

会计考友

</p>　　Response.Write ("无法压缩，请检查错误信息
0 m% y& K5 `0 ~) h3 l" & Err.number & "
1 {( r3 A  X  s' e! w3 u" & Err.Description)
　　Err.Clear
　　Exit function
　　End If
　　If DbVer=0 Then
$ {- n8 b+ M' Y- W' X　　call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.3.51;Data Source=" & SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.3.51;Data
0 Q- j, u+ z# ^! j4 P# H　　Source=" & SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True")
+ y: R; s0 z1 N　　Else
　　call Cd.CompactDatabase("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
　　SavePath & dbFileName,"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
　　SavePath & dbFileName & ".bak.mdb;Jet OLEDB;Encrypt Database=True")
　　End If
- I* w9 K% L: i4 a: e　　’删除旧的数据库文件
　　call DeleteFile(SavePath & dbFileName)
　　’将压缩后的数据库文件还原
　　call RenameFile(SavePath & dbFileName & ".bak.mdb",SavePath & dbFileName)
( g' o4 b4 N/ A4 @( g0 @　　Set Cd = False
　　CompactDatabase = True
  n  z4 t4 k" g. y　　End If
, {& U6 O$ _  w& _, G* b　　end function