frmcompact_db.frm

几个不错的VB例子

VERSION 5.00
Begin VB.Form frmCompact_DB 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Compact DB's"
   ClientHeight    =   1500
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4005
   ControlBox      =   0   'False
   BeginProperty Font 
      Name            =   "Verdana"
      Size            =   6.75
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmCompact_DB.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1500
   ScaleWidth      =   4005
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.FileListBox FileDB 
      Height          =   630
      Left            =   3435
      Pattern         =   "*.mdb"
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   90
      Visible         =   0   'False
      Width           =   1470
   End
   Begin VB.Label lblDBNumber 
      Alignment       =   2  'Center
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   600
      TabIndex        =   3
      Top             =   255
      Width           =   2805
   End
   Begin VB.Label lblDB 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   240
      Left            =   450
      TabIndex        =   2
      Top             =   960
      Width           =   3105
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Compacting DB's..."
      Height          =   180
      Left            =   1275
      TabIndex        =   1
      Top             =   660
      Width           =   1440
   End
End
Attribute VB_Name = "frmCompact_DB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim I As Integer
Dim sOldName As String
Dim sNewName As String


Private Sub Form_Load()
    
    Me.Show
    Me.Refresh
    
    FileDB.Path = App.Path
    lblDBNumber.Caption = FileDB.ListCount & " database/s found"
    lblDBNumber.Refresh
    
    For I = 0 To FileDB.ListCount - 1
    
        FileDB.ListIndex = I
        
        sOldName = App.Path & "\" & FileDB.FileName
        sNewName = Left(sOldName, Len(sOldName) - 1) & "N"
        
        lblDB.Caption = Right(sOldName, Len(sOldName) - InStrRev(sOldName, "\"))
        lblDB.Refresh
        
        DBEngine.CompactDatabase sOldName, sNewName, dbLangGeneral, dbVersion30 + dbEncrypt
    
        Kill sOldName
        Name sNewName As sOldName
    
    Next I
    
    End
    
End Sub