|
Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
COMPACTAGE ET SAUVEGARDE D'UNE BASE DE DONNÉE .MDB
Information sur la source
Description
Ce code aide l'utilisateur a choisir une base de donnée .MDB dans le chemin courant, faire le compactage et choisir sur quel disque la mettre (lecteur ZIP, Flash disque, CD ... ou autre) pour la sauvegarde.
Source
- Option Explicit
- Dim passwords, mpasse, source
- Dim base_de_donnees As Database
- Dim tables As Variant
- Dim i, j As Integer
- Dim chaine As String
-
- Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
- If KeyCode = 13 Then
- If Shift = 0 Then
- KeyCode = 0
- SendKeys "{TAB}"
- Else
- KeyCode = 0
- SendKeys "+{TAB}"
- End If
- End If
- End Sub
-
- Private Sub Form_Load()
- source = "gc.mdb"
- passwords = Array("banana", "master", "ricky", "ibis", "marsouin", "alize")
- For i = 0 To UBound(passwords)
- On Error Resume Next
- mpasse = ";pwd=" & passwords(i)
- Set base_de_donnees = OpenDatabase(source, False, False, mpasse)
- If Err.Number <> 3031 Then
- Exit For
- End If
- Next
- If Err.Number <> 0 Then
- Select Case Err.Number
- Case 3024
- MsgBox "La base de données est Introuvable dans le Chemin spécifiée"
- Case 3045
- MsgBox "La base de données ne peut etre ouverte en ce moment " & vbCrLf & " car elle est ouverte en mode exclusif par un autre utilisateur "
- End Select
- Exit Sub
- End If
- Me.KeyPreview = True
- Me.Width = 6810
- Me.Height = 3525
- On Error Resume Next
- Set base_de_donnees = OpenDatabase(source, False, False, mpasse)
- 'Si table de travail Inutile alors effacer avant le compactage
- tables = Array("distqte", "d1", "distval", "livconc", "flash1", "flash2", "flash3", "liqclt", "flashm", "anuclt", "cltmaj", "concess", "lstcp", "remise", "annubts", "boutclt", "boutemb", "compdgb", "creage", "encaissdgb", "etat104", "etatliquide", "etatttl", "etattva", "glivre", "listeclt", "listepro", "lstpieces", "releve", "regage", "regannu", "releveage", "wilclt", "chifaff", "pconc", "entete", "detail", "fstock", "tabfact", "fbt01")
- For i = 0 To UBound(tables)
- chaine = "DROP table " & tables(i) & ";"
- base_de_donnees.Execute chaine
- Next
- compact.Caption = "Compactage Base de Donnees"
- sauve.Caption = "Sauvegarde GC"
- sauve.Enabled = False
- End Sub
-
- Private Sub compact_Click()
- base_de_donnees.Close
- On Error Resume Next
- compact.Caption = " Compactage En cours ..."
- base_de_donnees.Close
- 'Nom de la base GC.mdb au moment du compactage,
- 'la mettre dans une base temporaire temp.mdb
- DBEngine.CompactDatabase "gc.mdb", "temp.mdb", , , ";pwd=banana"
- Kill "gc.mdb"
- FileCopy "temp.mdb", "gc.mdb"
- Kill "temp.mdb"
- compact.Caption = " Compactage Base de Donnees"
- MsgBox "Compactage de la Base de Données et Terminée"
- End Sub
-
- Private Sub sauve_Click()
- 'base_de_donnees.Close
- Dim sources, destination, nombase
- sauve.Caption = " Sauvegarde En Cours ..."
- nombase = "gc.mdb"
- source = CurDir()
- destination = Drive1.Drive
- If Right(source, 1) <> "\" Then
- source = source & "\"
- End If
- FileCopy source & nombase, destination & nombase
- sauve.Caption = " Sauvegarde GC"
- MsgBox "Copie Terminée"
- End Sub
-
- Private Sub drive1_Change()
- Dim fs As Object
- Dim d, s, t
- Set fs = CreateObject("Scripting.FileSystemObject") 'Affecation d'un nouveau objet
- Set d = fs.GetDrive(Drive1.Drive) 'affectation d'un nouveau objet a un objet existant
- Select Case d.drivetype
- Case 0: t = "Inconnu"
- Case 1: t = "Amovible"
- Case 2: t = "Fixe"
- Case 3: t = "Réseau"
- Case 4: t = "CD-ROM"
- Case 5: t = "Disque RAM"
- End Select
- s = "Lecteur " & d.DriveLetter & ": - " & t
- If d.isready Then 'ISREADY Boolean (True OR False )
- File1.Path = Drive1.Drive
- File1.Refresh
- Else
- ' s = s & vbCrLf & "Lecteur non prêt."
- s = "Lecteur non prêt."
- MsgBox s
- Drive1.Drive = "c:"
- End If
- sauve.Enabled = True
- End Sub
-
- Private Sub quitter_Click()
- Unload Me
- End Sub
Option Explicit
Dim passwords, mpasse, source
Dim base_de_donnees As Database
Dim tables As Variant
Dim i, j As Integer
Dim chaine As String
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
If Shift = 0 Then
KeyCode = 0
SendKeys "{TAB}"
Else
KeyCode = 0
SendKeys "+{TAB}"
End If
End If
End Sub
Private Sub Form_Load()
source = "gc.mdb"
passwords = Array("banana", "master", "ricky", "ibis", "marsouin", "alize")
For i = 0 To UBound(passwords)
On Error Resume Next
mpasse = ";pwd=" & passwords(i)
Set base_de_donnees = OpenDatabase(source, False, False, mpasse)
If Err.Number <> 3031 Then
Exit For
End If
Next
If Err.Number <> 0 Then
Select Case Err.Number
Case 3024
MsgBox "La base de données est Introuvable dans le Chemin spécifiée"
Case 3045
MsgBox "La base de données ne peut etre ouverte en ce moment " & vbCrLf & " car elle est ouverte en mode exclusif par un autre utilisateur "
End Select
Exit Sub
End If
Me.KeyPreview = True
Me.Width = 6810
Me.Height = 3525
On Error Resume Next
Set base_de_donnees = OpenDatabase(source, False, False, mpasse)
'Si table de travail Inutile alors effacer avant le compactage
tables = Array("distqte", "d1", "distval", "livconc", "flash1", "flash2", "flash3", "liqclt", "flashm", "anuclt", "cltmaj", "concess", "lstcp", "remise", "annubts", "boutclt", "boutemb", "compdgb", "creage", "encaissdgb", "etat104", "etatliquide", "etatttl", "etattva", "glivre", "listeclt", "listepro", "lstpieces", "releve", "regage", "regannu", "releveage", "wilclt", "chifaff", "pconc", "entete", "detail", "fstock", "tabfact", "fbt01")
For i = 0 To UBound(tables)
chaine = "DROP table " & tables(i) & ";"
base_de_donnees.Execute chaine
Next
compact.Caption = "Compactage Base de Donnees"
sauve.Caption = "Sauvegarde GC"
sauve.Enabled = False
End Sub
Private Sub compact_Click()
base_de_donnees.Close
On Error Resume Next
compact.Caption = " Compactage En cours ..."
base_de_donnees.Close
'Nom de la base GC.mdb au moment du compactage,
'la mettre dans une base temporaire temp.mdb
DBEngine.CompactDatabase "gc.mdb", "temp.mdb", , , ";pwd=banana"
Kill "gc.mdb"
FileCopy "temp.mdb", "gc.mdb"
Kill "temp.mdb"
compact.Caption = " Compactage Base de Donnees"
MsgBox "Compactage de la Base de Données et Terminée"
End Sub
Private Sub sauve_Click()
'base_de_donnees.Close
Dim sources, destination, nombase
sauve.Caption = " Sauvegarde En Cours ..."
nombase = "gc.mdb"
source = CurDir()
destination = Drive1.Drive
If Right(source, 1) <> "\" Then
source = source & "\"
End If
FileCopy source & nombase, destination & nombase
sauve.Caption = " Sauvegarde GC"
MsgBox "Copie Terminée"
End Sub
Private Sub drive1_Change()
Dim fs As Object
Dim d, s, t
Set fs = CreateObject("Scripting.FileSystemObject") 'Affecation d'un nouveau objet
Set d = fs.GetDrive(Drive1.Drive) 'affectation d'un nouveau objet a un objet existant
Select Case d.drivetype
Case 0: t = "Inconnu"
Case 1: t = "Amovible"
Case 2: t = "Fixe"
Case 3: t = "Réseau"
Case 4: t = "CD-ROM"
Case 5: t = "Disque RAM"
End Select
s = "Lecteur " & d.DriveLetter & ": - " & t
If d.isready Then 'ISREADY Boolean (True OR False )
File1.Path = Drive1.Drive
File1.Refresh
Else
' s = s & vbCrLf & "Lecteur non prêt."
s = "Lecteur non prêt."
MsgBox s
Drive1.Drive = "c:"
End If
sauve.Enabled = True
End Sub
Private Sub quitter_Click()
Unload Me
End Sub
Fichier Zip
Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !
Télécharger le zip
Historique
- 16 mai 2005 11:36:45 :
- Rajout de la base GC.MDB dans le .ZIP
Sources du même auteur
Sources de la même categorie
Sources en rapport avec celle ci
Commentaires et avis
Discussions en rapport avec ce code source dans le forum
Compactage de base de données ACCESS automatique [ par Nitocris ]
Comment faire pour automatiser le compactage de la base de donnée ?J'aimerais que le compactage se réalise tous les soir a une certaine heure ou quant
Ouvrir une base de données depuis access [ par David2410 ]
Bonjour, J'aimerais ouvrir une bas de données Access depuis vb6, mais j'ai un souci. Je ne peux pas déclarer ma variable en tant que database comme ci
Compactage de base Access 2000 [ par PierreRIVET ]
Je recherche le code à inscrire dans un logiciel en VB6 de manière à compacter la base de données, par exemple à la fermeture du logiciel.La basse de
Compactage d'une base de données en Access 2000 [ par PierreRIVET ]
Je cherche à compacter une base de données en Access 2000 à l'aide du code VB6 inclus dans le logiciel.Pour l'instant j'utilise la méthode CompactData
Connection à une base de données [ par chris3838 ]
Bonjour,Je recommence à développer une petite appli en Access et VBA. J'ai un souci de connection et de déclaration de variables (ça commence mal !!!)
Probleme de compactage et reparation d'une base de données acess 2000 [ par mouajria ]
bonjourpour reparer ma base de donnée j'utilise le code suivantDBEngine.RepairDatabase sNewNamea l'execution de cette ligne ,vb donne  
multithread avec une base de données Access [ par veyraud ]
Salut à tous, Je développe une appli qui doit faire des acces concurents sur une même base de données. C'est un peu long , mais j
Réseau et base de données [ par kLuxiWare ]
BonjourJ'ai une base de données utilisé à partir de VB en réseau.Lors de la fermeture de l'application je réalise un co
CREATE DATABASE [ par Compufly ]
Bonjour,J'essaie d'utiliser une base de données ACCESS dans mon code en VB6.J'aimerais que mon code crée une base de données ACCESS vid
Sauvegarde de fichier [ par aydendeliadon ]
Bonjour à tous,J'ai écrit un code en vb.net qui me permet d'exporter des données d'un automate vers une base de données. De cette
|
Téléchargements
Logiciels à télécharger sur le même thème :
Comparez les prix Nouvelle version

HTC Touch HD
Entre 25€ et 605€
|