One of the projects that I have been working on recently required creating tables in SQL Server using Visual Basic 6. The idea is to give the end user access to SQL Server in a limited fashion. They can create and edit tables using a GUI created in Visual Basic.




This is what it looks like in Visual Basic 6

The code for the form is below

Option Explicit

Private Sub Check1_Click()

'if this is checked then we create tables

If Check1.Value = 1 Then

   frm_table.Visible = True
   Check2.Value = False
   Check3.Value = False
   Frame2.Visible = False
   Frame4.Visible = False

Else
End If


End Sub

Private Sub Check2_Click()

'if this is checked then we edit tables

If Check2.Value = 1 Then

   Frame2.Visible = True
   Check1.Value = False
   Check3.Value = False

   frm_table.Visible = False
   Frame4.Visible = False

Else
End If

End Sub

Private Sub Check3_Click()

'if this is checked then we delete tables

If Check3.Value = 1 Then

   Frame4.Visible = True
   Check1.Value = False
   Check2.Value = False

   Frame2.Visible = False
   frm_table.Visible = False

Else
End If

End Sub

Private Sub cmd_end_Click()

'exit the prog
End

End Sub



Private Sub cmd_field_1_Click()

'This procedure is used to create the field meta table which
'is one of the default tables created. The structure of the
'table does not change. Hence we create the table with one
'SQL command and use the execute method in this case

'error handler
On Error GoTo errhandler

'name of the table is field meta
tablename2 = tablename & "_field_meta"

'this is the transact sql command used to create field meta table

SQL = " CREATE TABLE " & tablename2 & "" _
& " (field_id integer identity NOT NULL, " _
& " field_db_name varchar(50) NULL," _
& " field_type varchar(50) NULL," _
& " field_gui_name varchar(100) NULL," _
& " field_gui_input_type varchar(50) NULL," _
& " field_option_id integer NULL," _
& " field_gui_description varchar(50) NULL," _
& " alt_field_option_id varchar (50) NULL," _
& " searchable Char(1) NULL," _
& " CONSTRAINT " & tablename2 & "_PK2 PRIMARY KEY(field_id))"


'using the execute method for the connection
cn.Execute SQL

'once the field meta table it created, the program gives
'you the option of entering data into the table

msgval = MsgBox("The table " & tablename2 & " has been created. ", conbtns3, "Create table")

msgval = MsgBox("Would you like to enter data in " & tablename2 & " now?", conbtns1, "Insert Data")

'the program opens up a new form (frm_field_meta)
'for the data entry

If msgval = 6 Then
   cmd_end.SetFocus
   frm_other.Hide
   frm_field_meta.Show

Else
   cmd_section_1.SetFocus

End If

Exit Sub

'error handler routine
errhandler:

msgval = MsgBox(Err.Description, conbtns2, "DB Error")

End Sub

Private Sub cmd_field_2_Click()

'this sub is used to edit field meta table

On Error GoTo errhandler

cmd_end.SetFocus
frm_other.Hide
frm_field_meta.Show

Exit Sub

'error handler routine
errhandler:

msgval = MsgBox(Err.Description, conbtns2, "DB Error")

frm_field_meta.Hide
frm_other.Show


End Sub

Private Sub cmd_field_3_Click()

'sub procedure to delete the table

On Error GoTo errhandler

tablename2 = tablename & "_field_meta"

msgval = MsgBox("Do you really want to delete " & tablename2 & " table?", conbtns1, " Delete table")
If msgval = 6 Then
   SQL = "Drop Table " & tablename2 & ""
   cn.Execute SQL
   msgval = MsgBox("The table " & tablename2 & " has been deleted!", conbtns4, "Delete table")
   cmd_section_3.SetFocus
Else
   cmd_end.SetFocus

End If

Exit Sub

'error handler routine
errhandler:

msgval = MsgBox(Err.Description, conbtns2, "DB Error")

End Sub

Private Sub cmd_group_1_Click()

'This procedure is used to create the group meta table which
'is one of the default tables created. The structure of the
'table does not change. Hence we create the table with one
'SQL command and use the execute method in this case

'error handler
On Error GoTo errhandler

'name of the table is field meta
tablename4 = tablename & "_group_meta"
pic1.Print tablename4
'Exit Sub

'this is the transact sql command used to create the table
SQL = " CREATE TABLE " & tablename4 & "" _
& " (group_id integer identity NOT NULL, " _
& " group_gui_name varchar(50) NULL," _
& " sections_in_this_group varchar(255) NULL," _
& " CONSTRAINT " & tablename4 & "_PK4 PRIMARY KEY(group_id))"

'using the execute method for the connection
cn.Execute SQL

'once the field meta table it created, the program gives
'you the option of entering data into the table

msgval = MsgBox("The table " & tablename4 & " has been created. ", conbtns3, "Create table")

msgval = MsgBox("Would you like to enter data in " & tablename4 & " now?", conbtns1, "Insert Data")

'the program opens up a new form for the data entry
If msgval = 6 Then
   cmd_index_1.SetFocus
   frm_other.Hide
   frm_group_meta.Show

Else

   cmd_index_1.SetFocus

End If

Exit Sub

'error handler routine
errhandler:

msgval = MsgBox(Err.Description, conbtns2, "DB Error")


End Sub

Private Sub cmd_group_2_Click()

'this sub is used to edit group meta table

On Error GoTo errhandler

Set rs = New ADODB.Recordset
rs.CursorLocation = adUseServer
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.Source = "select * from " & tablename & "_group_meta"
Set rs.ActiveConnection = cn

cmd_index_2.SetFocus
frm_other.Hide
frm_group_meta.Show

Exit Sub

'error handler routine
errhandler:
msgval = MsgBox(Err.Description, conbtns2, "DB Error")

End Sub

Private Sub cmd_group_3_Click()

'sub procedure to delete the table

On Error GoTo errhandler

tablename2 = tablename & "_group_meta"

msgval = MsgBox("Do you really want to delete " & tablename2 & " table?", conbtns1, " Delete table")
If msgval = 6 Then
   SQL = "Drop Table " & tablename2 & ""
   cn.Execute SQL
   msgval = MsgBox("The table " & tablename2 & " has been deleted!", conbtns4, "Delete table")
   cmd_index_3.SetFocus
Else
   cmd_end.SetFocus

End If

Exit Sub
'error handler routine
errhandler:

msgval = MsgBox(Err.Description, conbtns2, "DB Error")

End Sub

Private Sub cmd_index_1_Click()

'This procedure is used to create the index meta table which
'is one of the default tables created. The structure of the
'table does not change. Hence we create the table with one
'SQL command and use the execute method in this case

'error handler
On Error GoTo errhandler

'name of the table is field meta
tablename5 = tablename & "_index_meta"
pic1.Print tablename5
'Exit Sub

'this is the transact sql command used to create the table

SQL = " CREATE TABLE " & tablename5 & "" _
& " (id integer NOT NULL, " _
& " db_index varchar(50) NULL, " _
& " field_db_name varchar(50) NULL," _
& " index_gui_name varchar(50) NULL," _
& " CONSTRAINT " & tablename5 & "_PK5 PRIMARY KEY(id))"

'using the execute method for the connection
cn.Execute SQL

'once the field meta table it created, the program gives
'you the option of entering data into the table

msgval = MsgBox("The table " & tablename5 & " has been created. ", conbtns3, "Create table")

'{

Set rs = New ADODB.Recordset
rs.CursorLocation = adUseServer
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.Source = "select * from " & tablename & "_index_meta"
Set rs.ActiveConnection = cn

rs.Open

rs.AddNew
rs.Fields(0) = 1
rs.Fields(1) = "unique_encounter_index"
rs.Update

rs.AddNew
rs.Fields(0) = 2
rs.Fields(1) = "unique_computer_index"
rs.Update

rs.AddNew
rs.Fields(0) = 3
rs.Fields(1) = "unique_patient_index"
rs.Update

rs.Close

msgval = MsgBox("Would you like to enter data in " & tablename5 & " now?", conbtns1, "Insert Data")

'the program opens up a new form for the data entry

If msgval = 6 Then
   cmd_user_1.SetFocus
   frm_other.Hide
   frm_index_meta.Show

Else
   cmd_user_1.SetFocus

End If

Exit Sub

'error handler routine
errhandler:
msgval = MsgBox(Err.Description, conbtns2, "DB Error")

End Sub

Private Sub cmd_index_2_Click()

'this is used to edit index table

On Error GoTo errhandler

Set rs = New ADODB.Recordset
rs.CursorLocation = adUseServer
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.Source = "select * from " & tablename & "_index_meta"
Set rs.ActiveConnection = cn

cmd_user_2.SetFocus
frm_other.Hide
frm_index_meta.Show

Exit Sub

'error handler routine

errhandler:
msgval = MsgBox(Err.Description, conbtns2, "DB Error")

End Sub

Private Sub cmd_index_3_Click()

'sub procedure to delete the table

On Error GoTo errhandler

tablename2 = tablename & "_index_meta"

msgval = MsgBox("Do you really want to delete " & tablename2 & " table?", conbtns1, " Delete table")
If msgval = 6 Then
   SQL = "Drop Table " & tablename2 & ""
   cn.Execute SQL
   msgval = MsgBox("The table " & tablename2 & " has been deleted!", conbtns4, "Delete table")
   cmd_user_3.SetFocus
Else
   cmd_end.SetFocus

End If

Exit Sub

'error handler routine
errhandler:

msgval = MsgBox(Err.Description, conbtns2, "DB Error")

End Sub


Private Sub cmd_meta_1_Click()

'This procedure is used to create the meta table which
'is one of the default tables created. The structure of the
'table does not change. Hence we create the table with one
'SQL command and use the execute method in this case

'error handler
On Error GoTo errhandler

'name of the table is field meta
tablename6 = tablename & "_meta"
pic1.Print tablename6
'Exit Sub

'this is the transact sql command used to create the table

SQL = " CREATE TABLE " & tablename6 & "" _
& " (unique_id integer identity NOT NULL, " _
& " key_name varchar(50) NULL, " _
& " value varchar(50) NULL," _
& " description varchar(255) NULL," _
& " CONSTRAINT " & tablename6 & "_PK6 PRIMARY KEY(unique_id))"

'& " CREATE UNIQUE INDEX " _
'& "unique_id_index on " & tablename6 & " (unique_id)"

'using the execute method for the connection
cn.Execute SQL

'once the field meta table it created, the program gives
'you the option of entering data into the table

msgval = MsgBox("The table " & tablename6 & " has been created. ", conbtns3, "Create table")

msgval = MsgBox("Would you like to enter data in " & tablename6 & " now?", conbtns1, "Insert Data")

Set rs = New ADODB.Recordset
rs.CursorLocation = adUseServer
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.Source = "select * from " & tablename & "_meta"
Set rs.ActiveConnection = cn

rs.Open

rs.AddNew
'rs.Fields(0) = 1
rs.Fields(1) = "form_list_option"
rs.Fields(2) = 44
rs.Fields(3) = "this is the first option drop list in the left hand menu"
rs.Update
rs.AddNew
'rs.Fields(0) = 2
rs.Fields(1) = "allow_anonymous"
rs.Fields(2) = "true"
rs.Fields(3) = "if true no username password field presented in left hand menu"
rs.Update
rs.AddNew
'rs.Fields(0) = 3
rs.Fields(1) = "menu_document"
rs.Fields(2) = "csp.html.factory.MenuDocument"
rs.Update
rs.AddNew
'rs.Fields(0) = 4
rs.Fields(1) = "view_document"
rs.Fields(2) = "csp.html.factory.ViewDocument"
rs.Update
rs.AddNew
'rs.Fields(0) = 5
rs.Fields(1) = "saved_document"
rs.Fields(2) = "csp.html.factory.SavedDocument"
rs.Update
rs.AddNew
'rs.Fields(0) = 6
rs.Fields(1) = "print_document"
rs.Fields(2) = "csp.html.factory.PrintDocument"
rs.Update
rs.AddNew
'rs.Fields(0) = 7
rs.Fields(1) = "error_document"
rs.Fields(2) = "csp.html.factory.ErrorDocument"
rs.Update
rs.AddNew
'rs.Fields(0) = 8
rs.Fields(1) = "email_to_field"
rs.Fields(2) = "typed_email_to"
rs.Fields(3) = "this value must exist in data and field meta tables"
rs.Update
rs.AddNew
'rs.Fields(0) = 9
rs.Fields(1) = "email_cc"
rs.Fields(2) = "email@xyz.com"
rs.Fields(3) = "eg record keeping email"
rs.Update
rs.AddNew
'rs.Fields(0) = 10
rs.Fields(1) = "pick_emailto_db_field"
rs.Fields(2) = "picked_email_gui_name"
rs.Fields(3) = "this value must exist in data and field meta tables"
rs.Update
rs.AddNew
'rs.Fields(0) = 11
rs.Fields(1) = "locked_document"
rs.Fields(2) = "csp.html.factory.LockedDocument"
rs.Update
rs.AddNew
'rs.Fields(0) = 12
rs.Fields(1) = "patient_browser"
rs.Fields(2) = "csp.html." & tablename & ".PatientBrowser"
rs.Update

rs.Close

msgval = MsgBox("The data was entered into meta table" & Chr(13) & Chr(10) & _
"Would you like to edit the table now?", conbtns1, "Meta table")


If msgval = 6 Then
   frm_other.Hide
   frm_meta.Show
Else
   Exit Sub
End If

Exit Sub

'error handler routine
errhandler:

msgval = MsgBox(Err.Description, conbtns2, "DB Error")


End Sub