Ver Mensaje Individual
  #2 (permalink)  
Antiguo 30/05/2006, 02:50
Avatar de Escalona
Escalona
 
Fecha de Ingreso: mayo-2005
Mensajes: 70
Antigüedad: 20 años
Puntos: 0
Bueno ya e encontrao el codigo pa compactar la BD, os lo pongo por si le interesa a alguien. Hasta la proxima.

'**************************************
'Windows API/Global Declarations for :Co
' mpacting Databases
'**************************************


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 CompactDatabase(Location As String, _
Optional BackupOriginal As Boolean = True)
On Error GoTo CompactErr

Dim strBackupFile As String
Dim strTempFile As String
'Check the database exists


If Len(Dir(Location)) Then
' Create Backup
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
' Do the compacting
'DBEngine is a reference to the Microsof
' t DAO Object Lib...
DBEngine.CompactDatabase Location, strTempFile
' Remove the uncompressed database
Kill Location
' Replace Uncompressed
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