Ver Mensaje Individual
  #2 (permalink)  
Antiguo 30/01/2006, 10:32
Alert
 
Fecha de Ingreso: junio-2004
Mensajes: 72
Antigüedad: 20 años, 10 meses
Puntos: 2
Haber si te sirve esto

Código:
<%
Const DriverConexion = "Provider=Microsoft.Jet.OLEDB.4.0; Data source="
Dim strDatabase, strFolder, strFileName
StrCarpeta = server.mappath("./Tu Carpeta/")

'Compacta la base de datos
Private Sub dbCompact(StrBaseDeDatos)
if right(StrCarpeta,1) <> "\" then StrCarpeta = StrCarpeta & "\"
Dim SourceConn, DestConn, oJetEngine, oFSO
SourceConn = DriverConexion & StrCarpeta & StrBaseDeDatos
DestConn = DriverConexion & StrCarpeta & "Temp" & StrBaseDeDatos
Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
Set oJetEngine = Server.CreateObject("JRO.JetEngine")

If Not oFSO.FileExists(StrCarpeta & StrBaseDeDatos) Then
    Response.Write ("Base no encontrada: " & StrCarpeta & StrBaseDeDatos)
else
    If oFSO.FileExists(StrCarpeta & "Temp" & StrBaseDeDatos) Then
       Response.Write ("Error. Intente Nuevamente.")
       oFSO.DeleteFile (StrCarpeta & "Temp" & StrBaseDeDatos)
    else
       oJetEngine.CompactDatabase SourceConn, DestConn
       oFSO.DeleteFile StrCarpeta & StrBaseDeDatos
       oFSO.MoveFile StrCarpeta & "Temp"& StrBaseDeDatos, StrCarpeta& StrBaseDeDatos
       Response.Write ("* La base de datos <B'>" & Request.form("DBFileName") & "</B'> fue compactada con exito.")
    End If
End If

Set oFSO = Nothing
Set oJetEngine = Nothing
End Sub

'Pinta la lista de bases en ese directorio
Private Sub dbList
Dim oFolders, i
i = 0
Set oFolders = Server.CreateObject("Scripting.FileSystemObject")
Response.Write ("<SELECT name='DBFileName''>")
For Each Item In oFolders.GetFolder(StrCarpeta).Files
    If LCase(Right(Item, 4)) = ".mdb" Then
       'corrijo el path, y saco la "\"
       item = Replace(lcase(Item), lcase(StrCarpeta), "")
       item = Replace(Item, "\", "")
       Response.Write ("<OPTION value='" & item &"'>" & item & "</OPTION>")
       i = i+1
    End If
Next
Response.Write ("</SELECT>")
Response.Write ("<BR><BR>En la carpeta <b'>"& StrCarpeta &"</b> hay <b>"& i &"</b> bases de datos Access.")
Set oFolders = Nothing
End Sub

Select Case Request.form("compactar")
    Case "Compactar"
    dbCompact Request.form("DBFileName")
End Select
%>

<p align="center"><b>Seleccionar la base para compactar de la lista</b>
<form method="POST" action="" id=form1 name=form1>
<%dbList%><BR><BR>
<input type="submit" value="Compactar" name="compactar">
</form></p>