VB压缩/修复Access数据库操作源代码

在Access数据库操作时经常数据库经常会由于操作频繁而出现各种问题.以及数据库无限的增大.为了不影响使用我们需要对数据库进行压缩/修复.以下代码就是用VB压缩并且修复Access数据库德 代码.大家可以直接使用.

Public  Declare  Function  GetTempPath Lib  " kernel32 "  Alias  " GetTempPathA "  (ByVal nBufferLength  As   Long , ByVal lpBuffer  As   String )  As   Long

  Public   Const  MAX_PATH  =   260

  Public   Sub  CompactJetDatabase(Location  As   String , Optional BackupOriginal  As   Boolean   =   True )

      On   Error   GoTo  CompactErr

      Dim  strBackupFile  As   String

      Dim  strTempFile  As   String

      ' 检查数据库文件是否存在

      If   Len (Dir(Location))  Then

         '  如果需要备份就执行备份

         If  BackupOriginal  =   True   Then

            strBackupFile  =  GetTemporaryPath  &   " backup.mdb "

            

             If   Len (Dir(strBackupFile))  Then  Kill strBackupFile

            

            FileCopy Location, strBackupFile

         End   If

         '  创建临时文件名

        strTempFile  =  GetTemporaryPath  &   " temp.mdb "

        

         If   Len (Dir(strTempFile))  Then  Kill strTempFile

        

         ' 通过DBEngine 压缩数据库文件

        DBEngine.CompactDatabase Location, strTempFile

         '  删除原来的数据库文件

        Kill Location

         '  拷贝刚刚压缩过临时数据库文件至原来位置

        FileCopy strTempFile, Location

         '  删除临时文件

        Kill strTempFile

     End   If

        

    

    

CompactErr:

    

              Exit   Sub

  End Sub

  Public   Function  GetTemporaryPath()

     Dim  strFolder  As   String

     Dim  lngResult  As   Long

    strFolder  =   String (MAX_PATH,  0 )

    lngResult  =  GetTempPath(MAX_PATH, strFolder)

     If  lngResult  <>   0   Then

        GetTemporaryPath  =   Left (strFolder,  InStr (strFolder,  Chr ( 0 ))  -   1 )

     Else

        GetTemporaryPath  =   ""

     End   If

  End Function