

'----------------------------------------------------------------
' Hands-On 19-1
' No code. 
' Please follow the instructions in the book.
'----------------------------------------------------------------


'----------------------------------------------------------------
' Hands-On 19-2
'----------------------------------------------------------------

Sub CreateTable()
    ' you must set up a reference to
    ' the Microsoft ActiveX Data Objects Library
    ' in the References dialog box
    Dim conn As ADODB.Connection
    Dim strTable As String

    On Error GoTo ErrorHandler
    
    Set conn = CurrentProject.Connection

    strTable = "tblSchools"
    conn.Execute "CREATE TABLE " & strTable & _
       "(SchoolID AUTOINCREMENT(100, 5), " & _
       "SchoolName CHAR," & _
       "City Char (25), District Char (35), " & _
       "YearEstablished Date);"

    Application.RefreshDatabaseWindow
ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub

'----------------------------------------------------------------
' Code on page 502
'----------------------------------------------------------------

Sub CreateTable2()
    Dim db As DAO.Database
    Dim strTable As String

    On Error GoTo ErrorHandler
    
    Set db = CurrentDb()
    
    strTable = "tblSchools2"
    
    db.Execute "CREATE TABLE " & strTable & _
       "(SchoolID AUTOINCREMENT(100, 5), " & _
       "SchoolName CHAR," & _
       "City Char (25), District Char (35), " & _
       "YearEstablished Date);"

    Application.RefreshDatabaseWindow
ExitHere:
    Set db = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 19-3
'----------------------------------------------------------------

Sub CreateTableInNewDB()
    ' use the References dialog box to set up a reference to
    ' Microsoft ADO Ext. for DDL and Security Object Library
    ' and Microsoft ActiveX Data Objects Library
    Dim cat As ADOX.Catalog
    Dim conn As ADODB.Connection
    Dim strDb As String
    Dim strTable As String
    Dim strConnect As String
    
    On Error GoTo ErrorHandler
    
    Set cat = New ADOX.Catalog
    strDb = CurrentProject.Path & "\Sites.mdb"
    strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                 "Data Source=" & strDb
    
    ' create a new database file
    cat.Create strConnect
    MsgBox "The database was created (" & strDb & ")."
    
    ' set connection to currently open catalog
    Set conn = cat.ActiveConnection
    
    strTable = "tblSchools"
    conn.Execute "CREATE TABLE " & strTable & _
        "(SchoolID AUTOINCREMENT(100, 5), " & _
        "SchoolName CHAR," & _
        "City Char (25), District Char (35), " & _
        "YearEstablished Date);"
ExitHere:
        Set cat = Nothing
        Set conn = Nothing
        Exit Sub
ErrorHandler:
        If Err.Number = -2147217897 Then
            ' delete the database file if it exists
            Kill strDb
            ' start from statement that caused this error
            Resume 0
        Else
            MsgBox Err.Number & ": " & Err.Description
            GoTo ExitHere
        End If
End Sub


'----------------------------------------------------------------
' Hands-On 19-4
'----------------------------------------------------------------

Sub DeleteTable()
    Dim conn As ADODB.Connection
    Dim strTable As String

    On Error GoTo ErrorHandler
    Set conn = CurrentProject.Connection

    strTable = "tblSchools"
    conn.Execute "DROP TABLE " & strTable
    Application.RefreshDatabaseWindow
ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    If Err.Number = -2147217900 Then
        DoCmd.Close acTable, strTable, acSavePrompt
        Resume 0
    Else
        MsgBox Err.Number & ":" & Err.Description
        Resume ExitHere
    End If
End Sub


'----------------------------------------------------------------
' Hands-On 19-5
'----------------------------------------------------------------

Sub AddNewField()
    Dim conn As ADODB.Connection
    Dim strTable As String
    Dim strCol As String

    On Error GoTo ErrorHandler
    Set conn = CurrentProject.Connection

    strTable = "tblSchools"
    strCol = "Budget2008"

    conn.Execute "ALTER TABLE " & strTable & _
        " ADD COLUMN " & strCol & " MONEY;"
ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 19-6
'----------------------------------------------------------------


Sub ChangeFieldType()
    Dim conn As ADODB.Connection
    Dim strTable As String
    Dim strCol As String

    On Error GoTo ErrorHandler
    Set conn = CurrentProject.Connection

    strTable = "tblSchools"
    strCol = "SchoolID"
    conn.Execute "ALTER TABLE " & strTable & _
         " ALTER COLUMN " & strCol & " CHAR(15);"
ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 19-7
'----------------------------------------------------------------

Sub ChangeFieldSize()
    Dim conn As ADODB.Connection
    Dim strTable As String
    Dim strCol As String

    On Error GoTo ErrorHandler
    Set conn = CurrentProject.Connection

    strTable = "tblSchools"
    strCol = "SchoolName"

conn.Execute "ALTER TABLE " & strTable & _
    " ALTER COLUMN " & strCol & " CHAR(40);"
ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 19-8
'----------------------------------------------------------------

Sub DeleteField()
    Dim conn As ADODB.Connection
    Dim strTable As String
    Dim strCol As String

    On Error GoTo ErrorHandler
    Set conn = CurrentProject.Connection

    strTable = "tblSchools"
    strCol = "Budget2008"

conn.Execute "ALTER TABLE " & strTable & _
    " DROP COLUMN " & strCol & ";"
ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 19-9
'----------------------------------------------------------------

Sub AddPrimaryKey()
    Dim conn As ADODB.Connection
    Dim strTable As String
    Dim strCol As String

    On Error GoTo ErrorHandler
    Set conn = CurrentProject.Connection

    strTable = "tblSchools"
    strCol = "SchoolID"

conn.Execute "ALTER TABLE " & strTable & _
    " ADD CONSTRAINT pKey PRIMARY KEY " & _
    "(" & strCol & ");"
ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 19-10
'----------------------------------------------------------------

Sub AddMulti_UniqueIndex()
    Dim conn As ADODB.Connection
    Dim strTable As String
    Dim strCol As String

    On Error GoTo ErrorHandler
    Set conn = CurrentProject.Connection

    strTable = "tblSchools"
    strCol = "SchoolID, District"

conn.Execute "ALTER TABLE " & strTable & _
     " ADD CONSTRAINT multiIdx UNIQUE " & _
     "(" & strCol & ");"
ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 19-11
'----------------------------------------------------------------

Sub DeleteIdxField()
    Dim conn As ADODB.Connection
    Dim strTable As String
    Dim strCol As String
    Dim strIdx As String

    On Error GoTo ErrorHandler
    Set conn = CurrentProject.Connection

    strTable = "tblSchools"
    strCol = "District"
    strIdx = "multiIdx"

conn.Execute "ALTER TABLE " & strTable & _
     " DROP CONSTRAINT " & strIdx & ";"

conn.Execute "ALTER TABLE " & strTable & _
    " DROP COLUMN " & strCol & ";"

ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 19-12
'----------------------------------------------------------------

Sub RemovePrimaryKeyIndex()
    Dim conn As ADODB.Connection
    Dim strTable As String
    Dim strIdx As String

    On Error GoTo ErrorHandler
    Set conn = CurrentProject.Connection

    strTable = "tblSchools"
    strIdx = "pKey"

conn.Execute "ALTER TABLE " & strTable & _
     " DROP CONSTRAINT " & strIdx & ";"

ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 19-13
'----------------------------------------------------------------

Sub SetDefaultFieldValue()
    Dim conn As ADODB.Connection
    Dim strTable As String
    Dim strCol As String
    Dim strDefVal As String
    Dim strSQL As String

    On Error GoTo ErrorHandler
    Set conn = CurrentProject.Connection

    strTable = "tblSchools"
    strCol = "City"
    strDefVal = "Boston"
    strSQL = "ALTER TABLE " & strTable & _
        " ALTER " & strCol & " SET DEFAULT " & strDefVal

    conn.Execute strSQL

ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 19-14
'----------------------------------------------------------------

Sub ChangeAutoNumber()
    Dim conn As ADODB.Connection
    Dim strDb As String
    Dim strConnect As String
    Dim strTable As String
    Dim strCol As String
    Dim intSeed As Integer

    On Error GoTo ErrorHandler

    strDb = CurrentProject.Path & "\" & "Sites.mdb"
    strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                 "Data Source=" & strDb

    strTable = "tblSchools"
    strCol = "SchoolID"
    intSeed = 1000

    Set conn = New ADODB.Connection
    conn.Open strConnect
    conn.Execute "ALTER TABLE " & strTable & _
         " ALTER COLUMN " & strCol & _
         " COUNTER (" & intSeed & ");"
ExitHere:
    conn.Close
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    If Err.Number = -2147467259 Then
        MsgBox "The database file cannot be located.", _
            vbCritical, strDb
        Exit Sub
    Else
        MsgBox Err.Number & ":" & Err.Description
        Resume ExitHere
    End If
End Sub

