Master 95 #1/MASTER95_1.iso/microsof/vbasic4/vb4-6.cab/newattch.frm

Visual Basic Form | 1995-07-26 | 7.2 KB | 249 lines

VERSION 4.00
Begin VB.Form frmNewAttach
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "New Attached Table"
   ClientHeight    =   3465
   ClientLeft      =   2355
   ClientTop       =   1590
   ClientWidth     =   4245
   Height          =   3870
   HelpContextID   =   2016135
   Icon            =   "NEWATTCH.frx":0000
   Left            =   2295
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3465
   ScaleWidth      =   4245
   Top             =   1245
   Width           =   4365
   Begin VB.ComboBox cboConnect
      Height          =   300
      ItemData        =   "NEWATTCH.frx":030A
      Left            =   120
      List            =   "NEWATTCH.frx":0338
      TabIndex        =   2
      Top             =   1560
      Width           =   3975
   End
   Begin VB.TextBox txtDatabase
      Height          =   285
      Left            =   120
      TabIndex        =   1
      Top             =   960
      Width           =   3975
   End
   Begin VB.CheckBox txtExclusive
      Caption         =   "AttachExclusive"
      Height          =   225
      Left            =   2160
      TabIndex        =   5
      Top             =   2520
      Width           =   1785
   End
   Begin VB.CheckBox chkSavePassword
      Caption         =   "AttachSavePWD"
      Height          =   225
      Left            =   120
      TabIndex        =   4
      Top             =   2520
      Width           =   1740
   End
   Begin VB.CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Height          =   435
      Left            =   2160
      TabIndex        =   7
      Top             =   2880
      Width           =   1905
   End
   Begin VB.CommandButton cmdAttach
      Caption         =   "&Attach"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   435
      Left            =   120
      TabIndex        =   6
      Top             =   2880
      Width           =   1905
   End
   Begin VB.ComboBox cboTableName
      Height          =   300
      Left            =   120
      TabIndex        =   3
      Top             =   2160
      Width           =   3975
   End
   Begin VB.TextBox txtAttachName
      Height          =   285
      Left            =   120
      TabIndex        =   0
      Top             =   360
      Width           =   3975
   End
   Begin VB.Label lblLabels
      AutoSize        =   -1  'True
      Caption         =   "Database Name: "
      Height          =   195
      Index           =   3
      Left            =   105
      TabIndex        =   11
      Top             =   720
      Width           =   1245
   End
   Begin VB.Label lblLabels
      AutoSize        =   -1  'True
      Caption         =   "Table to Attach: "
      Height          =   195
      Index           =   2
      Left            =   120
      TabIndex        =   10
      Top             =   1920
      Width           =   1185
   End
   Begin VB.Label lblLabels
      AutoSize        =   -1  'True
      Caption         =   "Connect String: "
      Height          =   195
      Index           =   1
      Left            =   105
      TabIndex        =   9
      Top             =   1320
      Width           =   1140
   End
   Begin VB.Label lblLabels
      AutoSize        =   -1  'True
      Caption         =   "Attachment Name: "
      Height          =   195
      Index           =   0
      Left            =   120
      TabIndex        =   8
      Top             =   105
      Width           =   1365
   End
Attribute VB_Name = "frmNewAttach"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdCancel_Click()
  Unload Me
End Sub
Sub Form_Load()
  CenterMe Me, gnMDIFORM
  cboConnect.ListIndex = 0
End Sub
Private Sub txtAttachName_Change()
  If Len(txtAttachName.Text) > 0 Then
    cmdAttach.Enabled = True
  Else
    cmdAttach.Enabled = False
  End If
  If cboTableName.ListCount > 0 Then cboTableName.Clear
End Sub
Private Sub cboConnect_Change()
  If Len(txtAttachName.Text) > 0 Then
    cmdAttach.Enabled = True
  Else
    cmdAttach.Enabled = False
  End If
  If cboTableName.ListCount > 0 Then cboTableName.Clear
End Sub
Private Sub cboTableName_DropDown()
  Dim db As Database
  Dim i As Integer
  Dim sDataType As String       'data type string
  Dim tdf As TableDef
  On Error GoTo DDErr
  SetHourglass
  If cboTableName.ListCount = 0 Then
    'fill in the list
    sDataType = GetConnectStr()
    If cboConnect.ListIndex = 0 Then
      'special case for Jet mdb tables
      Set db = gwsMainWS.OpenDatabase(gsNULL_STR, 0, 0, sDataType)
    Else
      Set db = gwsMainWS.OpenDatabase(gsNULL_STR, 0, 0, sDataType & ";" & cboConnect.Text)
    End If
    For Each tdf In db.TableDefs
      If (tdf.Attributes And dbSystemObject) = 0 Then
        cboTableName.AddItem tdf.Name
      End If
    Next
  End If
  Screen.MousePointer = vbDefault
  Exit Sub
DDErr:
  ShowError
  Exit Sub
End Sub
Private Sub cmdAttach_Click()
  On Error GoTo AttachErr
  Dim sConnect As String
  Dim tbl As TableDef
  Dim i As Integer
  If DupeTableName(txtAttachName.Text) = True Then
    txtAttachName.SetFocus
    Exit Sub
  End If
  MsgBar "Attaching " & txtAttachName.Text, True
  SetHourglass
  sConnect = GetConnectStr()
  'set the properties
  Set tbl = gdbCurrentDB.CreateTableDef(txtAttachName.Text)
  tbl.SourceTableName = cboTableName.Text
  tbl.Connect = sConnect
  If chkSavePassword.Value = 1 Then
    tbl.Attributes = dbAttachSavePWD
  End If
  If txtExclusive.Value = 1 Then
    tbl.Attributes = tbl.Attributes Or dbAttachExclusive
  End If
  gdbCurrentDB.TableDefs.Append tbl
  RefreshTables frmTables.lstTables, True
  'make sure and remove it if it was overwritten
  frmAttachments.grdTables.Col = 0
  For i = 1 To frmAttachments.grdTables.Rows - 1
    frmAttachments.grdTables.Row = i
    If UCase(frmAttachments.grdTables.Text) = UCase(txtAttachName.Text) Then
      frmAttachments.grdTables.RemoveItem i
      Exit For
    End If
  Next
  'add it to the list
  frmAttachments.grdTables.AddItem txtAttachName.Text & Chr(9) & cboTableName.Text & Chr(9) & sConnect
  'get rid of the 1st item if it is blank
  frmAttachments.grdTables.Row = 0
  frmAttachments.grdTables.Col = 0
  If Len(frmAttachments.grdTables.Text) = 0 Then
    frmAttachments.grdTables.RemoveItem 0
  End If
  Screen.MousePointer = vbDefault
  txtAttachName.Text = gsNULL_STR
  cboTableName.Text = gsNULL_STR
  MsgBar gsNULL_STR, False
  Screen.MousePointer = vbDefault
  Exit Sub
AttachErr:
  ShowError
  Exit Sub
End Sub
Private Function GetConnectStr() As String
  On Error GoTo GCErr
  Dim sTmp As String
  If cboConnect.ListIndex = 0 Then
    sTmp = ";"
  Else
    sTmp = cboConnect.Text & ";"
  End If
  If Len(txtDatabase.Text) > 0 Then
    sTmp = sTmp & "database=" & txtDatabase
  End If
  GetConnectStr = sTmp
  Exit Function
GCErr:
  ShowError
  Exit Function
End Function