attach.frm

《VB6数据库开发指南》所有的例程的源码

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.1#0"; "COMDLG32.OCX"
Begin VB.Form frmAttach 
   BackColor       =   &H00C0C0C0&
   Caption         =   "Chapter 5.2 Example"
   ClientHeight    =   1560
   ClientLeft      =   1095
   ClientTop       =   1515
   ClientWidth     =   4200
   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     =   1560
   ScaleWidth      =   4200
   Begin VB.CommandButton cmdClose 
      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          =   555
      Left            =   1170
      TabIndex        =   2
      Top             =   900
      Width           =   1815
   End
   Begin VB.CommandButton cmdDetach 
      Caption         =   "&Detach a 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          =   555
      Left            =   2280
      TabIndex        =   1
      Top             =   90
      Width           =   1815
   End
   Begin VB.CommandButton cmdAttach 
      Caption         =   "&Attach a 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          =   555
      Left            =   90
      TabIndex        =   0
      Top             =   90
      Width           =   1815
   End
   Begin MSComDlg.CommonDialog cdlFile 
      Left            =   60
      Top             =   2370
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   327680
   End
End
Attribute VB_Name = "frmAttach"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const SOURCE_FILE = 1
Const DESTINATION_FILE = 2
Const DETACH_FILE = 3

Private Sub cmdAttach_Click()
    Static strSourceFile As String, strDestFile As String
    Dim strTableName As String
    Dim dbfAttach As Database, tdfAttach As TableDef
        
    strDestFile = GetMDBFile(DESTINATION_FILE)
    
    If Len(strDestFile) Then strSourceFile = GetMDBFile(SOURCE_FILE)
    
    If Len(strSourceFile) Then
        'Call the custom method, Display, from frmSelector.  This
        'will return either "" or the name of a selected table.
        strTableName = frmSelector.Display(True, strSourceFile)
        On Error GoTo BadAttach
            If Len(strTableName) Then
                'If we have a table, let's attach it.
                Set dbfAttach = Workspaces(0).OpenDatabase(strDestFile)
                'Generate a TableDef object
                Set tdfAttach = dbfAttach.CreateTableDef(strTableName)
                'Provide the connection info
                tdfAttach.Connect = ";DATABASE=" & strSourceFile
                'Provide the table's name
                tdfAttach.SourceTableName = strTableName
                'Append it to the database's TableDefs collection
                dbfAttach.TableDefs.Append tdfAttach
                'And it's good!
                MsgBox "Table " & strTableName & " attached to " & _
                    GetFileName(strDestFile) & "."
            End If
        On Error GoTo 0
    End If
Exit Sub

BadAttach:
    MsgBox Err.Description, vbExclamation
End Sub
Private Sub cmdDetach_Click()
    Static strDetachFile As String
    Dim strTableName As String
    Dim dbfDetach As Database
    
    strDetachFile = GetMDBFile(DETACH_FILE)
    
    'Call frmSelector's Display method
    If Len(strDetachFile) Then strTableName = frmSelector.Display(False, strDetachFile)

    On Error GoTo BadDetach
        If Len(strTableName) Then
            'If we have a table, then detach it.
            Set dbfDetach = Workspaces(0).OpenDatabase(strDetachFile)
            dbfDetach.TableDefs.Delete strTableName
            MsgBox "Table " & strTableName & " detached from " & _
                GetFileName(strDetachFile) & "."
        End If
    On Error GoTo 0
Exit Sub

BadDetach:
    MsgBox Err.Description, vbExclamation
End Sub
Private Sub cmdClose_Click()
    End
End Sub
Private Function GetMDBFile(intPurpose As Integer) As String
    On Error GoTo GetMDBFileError
        Select Case intPurpose
            Case SOURCE_FILE
                cdlFile.DialogTitle = "Select Source File For Attach"
            Case DESTINATION_FILE
                cdlFile.DialogTitle = "Select Destination File For Attach"
            Case DETACH_FILE
                cdlFile.DialogTitle = "Select Source File For Detach"
        End Select
    
        With cdlFile
            .DefaultExt = "*.MDB"
            .Filter = "Access Files *.MDB|*.MDB|All Files *.*|*.*"
            'The user must select an existing file.
            .Flags = cdlOFNFileMustExist
            .CancelError = True
            .filename = "*.MDB"
            .ShowOpen
        End With
            
        GetMDBFile = cdlFile.filename
    On Error GoTo 0
Exit Function

GetMDBFileError:
    Exit Function
End Function