none
SCRIPT para Access RRS feed

  • Pregunta

  • Buenas tardes, necesito poder compactar y reparar una base de access por script, para poder ejecutarlo todas las noches sin tener que hacerlo yo..., alguien sabe como hacerlo?
    Slds, gracias
    lunes, 21 de enero de 2008 18:51

Respuestas

  • Aquí dejo el código que funciona perfectamente, para los que les interese un script para compactar y reparar una MDB de access en VBScript:

    Saludos!!

    Const strDBDir = "D:\BD"
    Dim arrDBs()
    Dim idx, tmpext

    'genera un codigo aleatorio para la base de datos que se crea temporalmente
    Randomize
    tmpext = "." & Int((999 - 100 + 1) * Rnd + lowerbound) & ".tmp"
    idx = 0

    Set WshShell = WScript.CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")

    GetFiles(strDBDir)
    GetSubFolders(strDBDir)

    for x = 0 to idx -1
     CompactDB(arrDBs(x))
    next

    Set WshShell = Nothing
    Set fso = Nothing

    'devuelve las supcarpetas
    Function GetSubFolders(strFld)
    Set objDBs = fso.GetFolder(strFld)
    Set objDBFolders = objDBs.SubFolders

    for each x in objDBFolders
     GetFiles(x)
     GetSubFolders(x)
    next

    Set objDBFolders = Nothing
    Set objDBs = Nothing
    end function

    'devuelve todos los ficheros
    Function GetFiles(strPath)
    Set objDBs = fso.GetFolder(strPath)
    Set objFiles = objDBs.Files
    for each f in objFiles
     if Ucase(FileExt(f)) = "MDB" then
      redim preserve arrDBs(idx+1)
      arrDBs(idx) = f
      idx = idx + 1
     end if
    next

    Set objDBs = Nothing
    Set objFiles = Nothing
    end function

    'devuelve la extension del fichero
    function FileExt(FullPath)
    dim x
    dim tmpstring

    x = Len(FullPath)
    for y = x to 1 step -1
     if mid(FullPath, y, 1) = "." then
      tmpstring = mid(Fullpath, y+1)
      exit for
     end if
    next
    FileExt = tmpstring
    end function

    'compacta la base de datos de access
    'recordar colocar la contraseña si hiciera falta
    Function CompactDB(dbPath)

    wscript.echo "Compacting " & dbPath

    Set fso1 = CreateObject("Scripting.FileSystemObject")
    Set jro = CreateObject("Jro.JetEngine")
    jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath & ";Jet OLEDB:Database Password=", _
    "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath & tmpext & ";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Password="
    fso1.DeleteFile(DBpath)
    fso1.MoveFile dbpath & tmpext, dbpath
    set jro = Nothing
    set fso1 = Nothing
    End Function



    SUERTE de un XANCLI!


    Jordi
    • Propuesto como respuesta sag4ever jueves, 19 de noviembre de 2009 12:19
    • Marcado como respuesta Atilla ArrudaModerator lunes, 8 de marzo de 2010 21:03
    jueves, 5 de noviembre de 2009 10:00

Todas las respuestas

  • IMPORTANTE

    Para que este Scrip funciones necesitas tener instalado Access

    Bloque de código

    Option Explicit

    'Definición de Variable
    Dim objAccess, objDbe

    Dim strRutaMdb


    'Inicialización de Varialbles
    strRutaMdb = "c:\ruta\BaseDeDatos.mdb"


    'Asignación de objetos
    Set objAccess = CreateObject("Access.Application")

    Set objDbe = objAccess.DBEngine

    'Compacto base de datos

    objDbe.CompactDatabase

     

    'Libero la varialbles

    Set objDbe = Nothing
    Set ObjAccess = Nothing


    Wscript.Quit(0)

     

     

    martes, 22 de enero de 2008 12:27
  • No funciona ese script
    Jordi
    jueves, 5 de noviembre de 2009 9:17
  • Aquí dejo el código que funciona perfectamente, para los que les interese un script para compactar y reparar una MDB de access en VBScript:

    Saludos!!

    Const strDBDir = "D:\BD"
    Dim arrDBs()
    Dim idx, tmpext

    'genera un codigo aleatorio para la base de datos que se crea temporalmente
    Randomize
    tmpext = "." & Int((999 - 100 + 1) * Rnd + lowerbound) & ".tmp"
    idx = 0

    Set WshShell = WScript.CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")

    GetFiles(strDBDir)
    GetSubFolders(strDBDir)

    for x = 0 to idx -1
     CompactDB(arrDBs(x))
    next

    Set WshShell = Nothing
    Set fso = Nothing

    'devuelve las supcarpetas
    Function GetSubFolders(strFld)
    Set objDBs = fso.GetFolder(strFld)
    Set objDBFolders = objDBs.SubFolders

    for each x in objDBFolders
     GetFiles(x)
     GetSubFolders(x)
    next

    Set objDBFolders = Nothing
    Set objDBs = Nothing
    end function

    'devuelve todos los ficheros
    Function GetFiles(strPath)
    Set objDBs = fso.GetFolder(strPath)
    Set objFiles = objDBs.Files
    for each f in objFiles
     if Ucase(FileExt(f)) = "MDB" then
      redim preserve arrDBs(idx+1)
      arrDBs(idx) = f
      idx = idx + 1
     end if
    next

    Set objDBs = Nothing
    Set objFiles = Nothing
    end function

    'devuelve la extension del fichero
    function FileExt(FullPath)
    dim x
    dim tmpstring

    x = Len(FullPath)
    for y = x to 1 step -1
     if mid(FullPath, y, 1) = "." then
      tmpstring = mid(Fullpath, y+1)
      exit for
     end if
    next
    FileExt = tmpstring
    end function

    'compacta la base de datos de access
    'recordar colocar la contraseña si hiciera falta
    Function CompactDB(dbPath)

    wscript.echo "Compacting " & dbPath

    Set fso1 = CreateObject("Scripting.FileSystemObject")
    Set jro = CreateObject("Jro.JetEngine")
    jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath & ";Jet OLEDB:Database Password=", _
    "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath & tmpext & ";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Password="
    fso1.DeleteFile(DBpath)
    fso1.MoveFile dbpath & tmpext, dbpath
    set jro = Nothing
    set fso1 = Nothing
    End Function



    SUERTE de un XANCLI!


    Jordi
    • Propuesto como respuesta sag4ever jueves, 19 de noviembre de 2009 12:19
    • Marcado como respuesta Atilla ArrudaModerator lunes, 8 de marzo de 2010 21:03
    jueves, 5 de noviembre de 2009 10:00