maketabl.frm

VB6数据库开发指南》的配套源程序

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00C0C0C0&
   Caption         =   "Chapter 3.14 Example"
   ClientHeight    =   4665
   ClientLeft      =   2025
   ClientTop       =   1560
   ClientWidth     =   6390
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4665
   ScaleWidth      =   6390
   Begin VB.ListBox lstData 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3570
      Left            =   120
      Sorted          =   -1  'True
      TabIndex        =   3
      Top             =   150
      Width           =   6135
   End
   Begin VB.CommandButton cmdClose 
      Cancel          =   -1  'True
      Caption         =   "&Close"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   4620
      TabIndex        =   2
      Top             =   3900
      Width           =   1635
   End
   Begin VB.CommandButton cmdDropTable 
      Caption         =   "D&rop Table"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   1920
      TabIndex        =   1
      Top             =   3900
      Width           =   1635
   End
   Begin VB.CommandButton cmdCreateTable 
      Caption         =   "Create &Table"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   615
      Left            =   120
      TabIndex        =   0
      Top             =   3900
      Width           =   1635
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Const BIBLIO_PATH = "D:\Program Files\Microsoft Visual Studio\VB6\Biblio.MDB"
Private dbfBiblio As Database
Private Sub Form_Load()
    Dim tdfTable As TableDef
    Dim blnTableFound As Boolean

    On Error GoTo LoadError
        blnTableFound = False
        'Open the database
        Set dbfBiblio = DBEngine.Workspaces(0).OpenDatabase(BIBLIO_PATH)
        
        'Check each table in the TableDefs collection; if the name matches,
        'then allow the user to drop the table, and populate the list box.
        For Each tdfTable In dbfBiblio.TableDefs
            If tdfTable.Name = "Publisher Titles" Then
                blnTableFound = True
                cmdDropTable.Enabled = True
                cmdCreateTable.Enabled = False
                FillList
                Exit For
            End If
        Next
    
        'If no table was found, allow the user to create the table.
        If blnTableFound = False Then
            cmdDropTable.Enabled = False
            cmdCreateTable.Enabled = True
        End If
    On Error GoTo 0
Exit Sub

LoadError:
    MsgBox Err.Description, vbExclamation
    Unload Me
Exit Sub

End Sub

Sub FillList()
    Dim recSelect As Recordset
    Dim strSQL As String

    On Error GoTo FillListError
        'Clear the list box
        lstData.Clear
        
        'Get the [Publisher Titles] table in a recordset
        Set recSelect = dbfBiblio.OpenRecordset("SELECT * FROM [Publisher Titles]", dbOpenSnapshot)
        'If there are any records, fill the list box
        If recSelect.RecordCount > 0 Then
            recSelect.MoveFirst
            Do Until recSelect.EOF
                lstData.AddItem recSelect![Name] & ": " & recSelect![Title]
                recSelect.MoveNext
            Loop
        End If
    On Error GoTo 0
Exit Sub

FillListError:
    MsgBox Err.Description, vbExclamation
Exit Sub

End Sub

Private Sub cmdCreateTable_Click()
    Dim strSQL As String

    On Error GoTo CreateTableError
        Screen.MousePointer = vbHourglass
    
        'Build the SELECT INTO statement.
        strSQL = "SELECT Publishers.Name, Titles.Title " & _
            "INTO [Publisher Titles] " & _
            "FROM Publishers INNER JOIN Titles " & _
            "ON Publishers.PubID = Titles.PubID"
    
        'Create the new table by executing the SQL statement.
        dbfBiblio.Execute (strSQL)
    
        'Fill the list box with records.
        FillList
    
        'Set the command buttons.
        cmdCreateTable.Enabled = False
        cmdDropTable.Enabled = True
    
        Screen.MousePointer = vbDefault
    On Error GoTo 0
Exit Sub

CreateTableError:
    Screen.MousePointer = vbDefault
    MsgBox Err.Description, vbExclamation
Exit Sub

End Sub


Private Sub cmdDropTable_Click()
    On Error GoTo DropTableError
        'Execute the DROP TABLE statement
        dbfBiblio.Execute ("DROP TABLE [Publisher Titles]")
        
        'Set the command buttons
        cmdDropTable.Enabled = False
        cmdCreateTable.Enabled = True
    
        'Clear the list box.
        lstData.Clear
    On Error GoTo 0
Exit Sub

DropTableError:
    MsgBox Err.Description, vbExclamation
Exit Sub

End Sub


Private Sub cmdClose_Click()
    End
End Sub