VB6 如何压缩access2007? - 编程论坛

#2

yuk_yu2012-03-02 11:18

回复楼主 yuk_yu

期待大师的解答！

#3

mayuebo2012-03-03 11:07

调用ADO对象的CompactDatabase 方法

#4

renyue_19832012-03-09 12:41

学习来的。谢谢

#5

yuk_yu2012-03-11 12:43

回复 3楼 mayuebo

你好，可以给个实例吗？谢谢

#6

yuk_yu2012-03-12 18:37

回复 5楼 yuk_yu

为何运行到 Location, strTempFile就不行呢？

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.accdb"

            If Len(Dir(strBackupFile)) Then Kill strBackupFile

            FileCopy Location, strBackupFile

        End If

        '创建临时文件名

        strTempFile = GetTemporaryPath & "temp.accdb"

        If Len(Dir(strTempFile)) Then Kill strTempFile

        '通过DBEngine压缩数据库文件

         Location, strTempFile

        '删除原来的数据库文件

        Kill Location

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

        FileCopy strTempFile, Location

        '删除临时文件

        Kill strTempFile

    Else

    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

[ 本帖最后由 yuk_yu 于 2012-3-12 18:39 编辑 ]

#7

yuk_yu2012-03-13 22:07

回复 6楼 yuk_yu

各位，可以指导下或给个实例吗？谢谢

#8

dboyxu2012-03-14 13:39

新手来学习

#9

linjq5262018-11-14 08:40

Private Sub CompactDb(DbPath As String, DbName As String)
On Error GoTo exit_sub
    Dim oPath As String
    Dim tPath As String
    oPath = DbPath & DbName & ".accdb"
    tPath = DbPath & "tmp.accdb"
    If Dir(oPath) = "" Then
        Exit Sub
    End If
    oPath, tPath
    Kill oPath
    Name tPath As oPath

exit_sub:

End Sub