Ver Mensaje Individual
  #1 (permalink)  
Antiguo 23/05/2002, 10:32
vgaray
 
Fecha de Ingreso: octubre-2000
Ubicación: Juarez, Chih.
Mensajes: 161
Antigüedad: 24 años, 6 meses
Puntos: 0
Compactar BD Access

Esta función sirve para compactar una base de datos de MS Access versión 97 ó 2000.

La forma para llamar la función será la siguiente...

<%
bdpath = "tu_bd.mdb"
v97 = "True" 'si la bd es access 97
'v97 = "False" 'si la bd es access 2000

If bdpath <> "" Then
bd = server.mappath(bdpath)
Response.Write(CompactDB(bd,v97))
End If
%>

<%
'code by: Michael Brinkley
option explicit
Const JET_3X = 4

Function CompactDB(dbPath, boolIs97)
Dim fso, Engine, strDBPath
strDBPath = left(dbPath,instrrev(DBPath,"\"))
Set fso = CreateObject("Scripting.FileSystemObject&quot ;)

If fso.FileExists(dbPath) Then
Set Engine = CreateObject("JRO.JetEngine")

If boolIs97 = "True" Then
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb;" _
& "Jet OLEDB:Engine Type=" & JET_3X
Else
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBPath & "temp.mdb"
End If
fso.CopyFile strDBPath & "temp.mdb",dbpath
fso.DeleteFile(strDBPath & "temp.mdb")
Set fso = nothing
Set Engine = nothing
CompactDB = "Your database, " & dbpath & ", has been Compacted" & vbCrLf
Else
CompactDB = "The database name or path has not been found. Try Again" & vbCrLf
End If
End Function
%>

Tan sólo creo que faltaría agregar dos líneas a esta función.

server.scriptTimeOut=xxx (en segundos y claro un número alto)

al inicio de la función, para impedir algún error de 'timeout' al realizar el proceso de compactación, y..

server.scriptTimeOut=90

al final de la función para reponer el valor original en esta variable.