compacter la base

Question

bonjour
je voudrais comacter ma base,mais ça ne fonctionne pas
voila mon code.

Private Sub Compacter_Click()'le bouton
Compact
End Sub
Option Explicit


'remplacer cette constante par votre mot de passe
Const c_sPASSWORD As String = "ufis"
Const c_sDATABASE As String = "centre_aéré.mdb"


Public Sub compact()
'remplacer la DB par la votre
 Dim sPath
 sPath = App.Path & "\BD" 
 If Right(sPath, 1) <> "" Then sPath = sPath & ""
 CompactDataBaseAccess sPath & c_sDATABASE, c_sPASSWORD
End Sub




'**************************************************************
'purpose : this sub compacts a database using JRO
'params: LocalDatabase : The actual db
'        sPassword : The DB password
'
'**************************************************************
Public Sub CompactDataBaseAccess(sLocalDatabase As String, sPassword As String)
    
    On Error GoTo ERRORHANDLER
    Screen.MousePointer = vbHourglass
    
    Dim oFSO As FileSystemObject
    Dim oJRO As JRO.JetEngine
    Dim sShortName As String, sExt As String
    Dim sCompactPart1    As String
    Dim sCompactPart2    As String
    
    Set oFSO = New FileSystemObject
    sShortName = oFSO.GetBaseName(sLocalDatabase)
    sExt = ".Bak"
    sShortName = sShortName & sExt


    sCompactPart1 = "Provider=Microsoft.Jet.OLEDB.4.0" & _
        ";Data Source=" & sLocalDatabase
    sCompactPart2 = "Provider=Microsoft.Jet.OLEDB.4.0" & _
        ";Data Source=" & sShortName
 
    Set oJRO = New JRO.JetEngine
    oJRO.CompactDatabase sCompactPart1, sCompactPart2
    
    ' delete the original database
    oFSO.DeleteFile sLocalDatabase
    oFSO.MoveFile sShortName, sLocalDatabase
    
   EXITPOINT:
    Screen.MousePointer = vbDefault
    If Not oFSO Is Nothing Then
      Set oFSO = Nothing
    End If
    If Not oJRO Is Nothing Then
      Set oJRO = Nothing
    End If
    Exit Sub


ERRORHANDLER:
    Resume EXITPOINT
End Sub

je crois que la base doit etre fermé,mais je ne sais pas comment faire.
merci
petchy

Renfield · Answer

Pour sur, tu dois avoir fermé ta base....

a noter que JetComp.exe est plus efficace pour la compression/reparation de base

Renfield
Admin CodeS-SourceS- MVP Visual Basic

cs_Exploreur · Answer

Salut à tous,

Petchy >> tu n'as pas bien regarder ma dernière source alors.... sinon regarde ici

A+
Exploreur

 Linux a un noyau, Windows un pépin

cs_petchy · Answer

salut Exploreur

si si j'ai bien regarder ta source "STOCK INFO GESTION INFORMATIQUE" 
mais je n'utilise pas le meme code pour l'ouverture de ma base,

Sub Main()
On Error GoTo erreur
'Connection base de donnée
Set Db = New ADODB.Connection
Db.Provider = "Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & App.Path & "\BD\centre_aéré.mdb ;Jet OLEDB:Database Password=ufis;"
Db.Open
frmconnexion.Show
Exit Sub
erreur:
MsgBox "Probleme de connection à la base de donnée" & vbCrLf & "Vérifiez que la base de donnée se situe dans le repertoire BD", vbCritical, "Erreur de connection"
End
End Sub
donc j'ai tous essayer pour fermer ma base avant de la compacter
Db.close
mais j'ai une erreur
si tu vois ou est l'erreur,fais moi signe 
merci
petchy

cs_Exploreur · Answer

Re,

Db, est déclaré où ? Dim ? Public ?

A+
Exploreur

 Linux a un noyau, Windows un pépin

cs_petchy · Answer

re
Db est déclaré e npublic

Public Db As ADODB.Connection

petchy

cs_Exploreur · Answer

Re,

C'est que ton problème est bizarre...!Je pense que ton problème ne vient pas du db.close, car il me vient à l'esprit, qu'une fois j'ai fais un essai de compactage avec mon snippet sur une bdd avec mot de pass, ben cela ne marchais pas !

Donc il est fort posible que ton problème vient de là...Essai avec ta même base mais sans mot de pass et en changeant ta chaine de connection...

A+
Exploreur

 Linux a un noyau, Windows un pépin

cs_petchy · Answer

salut
ha bon,ben je crois que je vais laisser tomber,car ça commence à etre compliquer.
merci Exploreur pour ton aide
@ plus
petchy

cs_Exploreur · Answer

Salut,

Regarde cette source de Bouv, je pense qu'elle pourrait t'aider..

A+
Exploreur

 Linux a un noyau, Windows un pépin

cs_petchy · Answer

Re

j'ai bien regarder le lien que tu ma donner,et j'ai toujours un probleme de fermeture de la base lors du compactage,pourtant j'ai bien enlever le mot de passe sur la base,mais j'ai le message
Call MsgBox("Le compactage a échoué !" & vbCrLf & vbCrLf & _
                      "Vérifiez que personne n'est connecté à la base !", vbExclamation + vbOKOnly, "Attention").
alors c'est agaçant    
tans pis je verrai un peu plus tard pour le compactage de la base.
@ plus
petchy

cs_Exploreur · Answer

Re,

Regarde la maj de mon snippet ici, il prend en compte l'ouverture pour le compactage de la bdd le mot de pass...

Note : Il a était mis à jour et rendu fonctionnel grâce à l'aide d'une personne du site(qui se reconnaitra)...

A+
Exploreur

 Linux a un noyau, Windows un pépin

cs_petchy · Answer

salut Exploreur

merci pour la mise à jour de ton snippet,le probleme c'est qu'il faut que je change ma connection avec ma base ,car quand je lance j'ai pas mal d'erreur.
donc je crois que je verrais plus tard pour le compactage de la base 
merci encore pour ton aide.
@plus
petchy

Compacter la base

11 réponses

Votre réponse

Discussions similaires