Content Supported by Sourcelens Consulting

VERSION 5.00
Begin VB.Form frmCopyStruct 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Copy Structure"
   ClientHeight    =   3300
   ClientLeft      =   1380
   ClientTop       =   1650
   ClientWidth     =   6525
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   HelpContextID   =   2016121
   Icon            =   "CPYSTRU.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2873.239
   ScaleMode       =   0  'User
   ScaleWidth      =   6436.072
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CheckBox chkCopyData 
      Caption         =   "Copy Data   "
      Height          =   255
      Left            =   3120
      MaskColor       =   &H00000000&
      TabIndex        =   9
      Top             =   2160
      Width           =   3135
   End
   Begin VB.TextBox txtDatabase 
      Height          =   285
      Left            =   3045
      TabIndex        =   1
      Top             =   420
      Width           =   3375
   End
   Begin VB.CommandButton cmdClose 
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Height          =   375
      Left            =   4800
      MaskColor       =   &H00000000&
      TabIndex        =   4
      Top             =   2730
      Width           =   1575
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   3000
      MaskColor       =   &H00000000&
      TabIndex        =   3
      Top             =   2730
      Width           =   1575
   End
   Begin VB.TextBox txtConnect 
      Height          =   540
      Left            =   3045
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   1155
      Width           =   3375
   End
   Begin VB.CheckBox chkCopyIndexes 
      Caption         =   "Copy Indexes"
      Height          =   255
      Left            =   3120
      MaskColor       =   &H00000000&
      TabIndex        =   2
      Top             =   1800
      Value           =   1  'Checked
      Width           =   3165
   End
   Begin VB.ListBox lstTables 
      Height          =   2400
      Left            =   105
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   5
      Top             =   360
      Width           =   2775
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      Caption         =   "(Note:Export is Faster)"
      Height          =   195
      Index           =   3
      Left            =   3360
      TabIndex        =   10
      Top             =   2400
      Width           =   1665
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      Caption         =   " Target Connect String: "
      Height          =   195
      Index           =   2
      Left            =   3045
      TabIndex        =   8
      Top             =   840
      Width           =   1740
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      Caption         =   " Target Database: "
      Height          =   195
      Index           =   1
      Left            =   3045
      TabIndex        =   7
      Top             =   105
      Width           =   1365
   End
   Begin VB.Label lblLabels 
      AutoSize        =   -1  'True
      Caption         =   " Tables: "
      Height          =   195
      Index           =   0
      Left            =   105
      TabIndex        =   6
      Top             =   105
      Width           =   615
   End
End
Attribute VB_Name = "frmCopyStruct"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
Const FORMCAPTION = "Copy Structure"
Const BUTTON1 = "&OK"
Const BUTTON2 = "&Close"
Const LABEL0 = "Tables:"
Const Label1 = "Target Database:"
Const Label2 = "Target Connect String:"
Const LABEL3 = "(Note: Export is Faster)"
Const CHKBOX1 = "Copy Indexes"
Const CHKBOX2 = "Copy Data"
Const MSG1 = "Copying Table(s)"
Const MSG2 = "Enter New Table Name:"
Const MSG3 = "Copy of Data was Unsuccessful!"
Const MSG4 = "Copy of Structure was Successful!"
'>>>>>>>>>>>>>>>>>>>>>>>>

Private Sub cmdClose_Click()
  RefreshTables Nothing   'just in case some were added
  Unload Me
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyF1 And Shift = 0 Then
    DisplayTopic 2016121
  End If
End Sub

Private Sub Form_Load()
  Dim i As Integer

  Me.Caption = FORMCAPTION
  cmdOK.Caption = BUTTON1
  cmdClose.Caption = BUTTON2
  lblLabels(0).Caption = LABEL0
  lblLabels(1).Caption = Label1
  lblLabels(2).Caption = Label2
  lblLabels(3).Caption = LABEL3
  chkCopyIndexes.Caption = CHKBOX1
  chkCopyData.Caption = CHKBOX2
  
  RefreshTables lstTables
  
  txtDatabase.Text = gsDBName
  txtConnect.Text = gdbCurrentDB.Connect
  
  'select the table that was selected on the database form
  For i = 0 To lstTables.ListCount - 1
    If lstTables.List(i) = gnodDBNode.Text Then
      lstTables.Selected(i) = True
      Exit For
    End If
  Next
End Sub

Private Sub cmdOK_Click()
  Dim i As Integer
  Dim bDifferentDB As Integer
  Dim sToName As String
  Dim dbToDatabase As Database

  On Error GoTo OkayErr

  MsgBar MSG1, True

  Screen.MousePointer = vbHourglass
  If Len(txtDatabase.Text) = 0 Or txtDatabase.Text = gsDBName Then
    Set dbToDatabase = gdbCurrentDB
    bDifferentDB = False
  Else
    Set dbToDatabase = gwsMainWS.OpenDatabase(txtDatabase.Text, False, False, txtConnect.Text)
    dbToDatabase.QueryTimeout = glQueryTimeout
    bDifferentDB = True
  End If

  For i = 0 To lstTables.ListCount - 1
    If lstTables.Selected(i) Then
      If bDifferentDB = False Then
        sToName = InputBox(MSG2)

        If Len(sToName) = 0 Then GoTo SkipIt
      Else
        sToName = (StripConnect(lstTables.List(i)))
      End If
    Else
      GoTo SkipIt
    End If

    Screen.MousePointer = vbHourglass
    If CopyStruct(gdbCurrentDB, dbToDatabase, (StripConnect(lstTables.List(i))), sToName, (chkCopyIndexes)) Then
      If chkCopyData = 1 Then
        If CopyData(gdbCurrentDB, dbToDatabase, (StripConnect(lstTables.List(i))), sToName) = False Then
          Beep
          MsgBox (StripConnect(lstTables.List(i))) & ": " & MSG3, vbInformation, Me.Caption
        End If
      End If
      Screen.MousePointer = vbDefault
      MsgBox (StripConnect(lstTables.List(i))) & ": " & MSG4, vbInformation, Me.Caption
      lstTables.Selected(i) = False
    Else
      Screen.MousePointer = vbDefault
      Beep
      MsgBox (StripConnect(lstTables.List(i))) & ": " & MSG3, vbInformation, Me.Caption
    End If

SkipIt:

  Next

  MsgBar vbNullString, False
  Exit Sub

OkayErr:
  ShowError
End Sub