Public Function CompactBase(ByRef CnxAdo As ADODB.Connection, Optional iJetType As Integer = 5) As Boolean '********************************************************/ ' Référence projet à rajouter : / ' Microsoft Jet And Replication Objects 2.6 Library / '********************************************************/ CompactBase = False Dim sPathSrc As String Dim sPathDest As String Dim sPassWord As String Dim Jro As New JetEngine ' la cnx doit être active If Not (CnxAdo Is Nothing) Then If Not (Cnx.State = adStateClosed) Then ' chemins & pass sPathSrc = CnxAdo.Properties.Item(7) sPathDest = sPathSrc & "_" & Format(Now, "DDMMYYHHNNSS") & ".mdbBAK" sPassWord = CnxAdo.Properties.Item(63) ' on ferme la base CnxAdo.Cancel CnxAdo.Close ' compactage On Error Resume Next Jro.CompactDatabase "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & sPathSrc & ";Jet OLEDB:Database Password=" & sPassWord & ";Jet OLEDB:Engine Type=" & CStr(iJetType) & ";", _ "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & sPathDest & ";Jet OLEDB:Database Password=" & sPassWord & ";Jet OLEDB:Engine Type=" & CStr(iJetType) & ";" ' pas d'erreur, on renomme, on reconnecte, et retour OK If Err.Number = 0 Then On Error GoTo 0 Kill sPathSrc Name sPathDest As sPathSrc CompactBase = True CnxAdo.Open End If End If End If ' libère Set Jro = Nothing End Function
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.