
'----------------------------------------------------------------
' Code on page 550
'----------------------------------------------------------------

Sub Create_View_CheapFreight()
    Dim conn As ADODB.Connection
    Set conn = CurrentProject.Connection
    conn.Execute "CREATE VIEW CheapFreight AS " & _
                 "SELECT Orders.[Order ID], Orders.[Shipping Fee], " & _
                 "Orders.[Ship Country/Region] " & _
                 "FROM Orders WHERE Orders.[Shipping Fee] < 20;"
    Application.RefreshDatabaseWindow
    conn.Close
    Set conn = Nothing
End Sub

Sub OpenView()
    DoCmd.OpenQuery "CheapFreight", acViewNormal
End Sub


'----------------------------------------------------------------
' Hands-On 23-1
'----------------------------------------------------------------

' Don't forget to set up a reference to the
' Microsoft ActiveX Data Objects Library
' in the References dialog box

Sub Create_View()
    Dim conn As ADODB.Connection

    Set conn = CurrentProject.Connection

    On Error GoTo ErrorHandler

    conn.Execute "CREATE VIEW vw_Employees AS " & _
                 "SELECT Employees.ID as [Employee ID], " & _
                 "[First Name] & chr(32) & [Last Name] as [Full Name], " & _
                 "[Job Title], Orders.[Order ID] as [Order ID] " & _
                 "FROM Employees " & _
                 "INNER JOIN Orders ON " & _
                 "Orders.[Employee ID] = Employees.ID;"

    Application.RefreshDatabaseWindow
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    If Err.Number = -2147217900 Then
        conn.Execute "DROP VIEW vw_Employees"
        Resume
    Else
        MsgBox Err.Number & ":" & Err.Description
        Resume ExitHere
    End If
End Sub


'----------------------------------------------------------------
' Hands-On 23-2
'----------------------------------------------------------------

' Don't forget to set up a reference to the
' Microsoft ADO Ext. 2.8 for DDL and Security
' object library

Sub List_Views()
    Dim cat As New ADOX.Catalog
    Dim myView As ADOX.View

    cat.ActiveConnection = CurrentProject.Connection

    For Each myView In cat.Views
        Debug.Print myView.Name
    Next myView
End Sub


'----------------------------------------------------------------
' Hands-On 23-3
'----------------------------------------------------------------

Sub Delete_View()
    Dim conn As ADODB.Connection

    Set conn = CurrentProject.Connection

    On Error GoTo ErrorHandler
    conn.Execute "DROP VIEW vw_Employees"
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    If Err.Number = -2147217865 Then
        MsgBox "The view was already deleted."
    Exit Sub
    Else
        MsgBox Err.Number & ":" & Err.Description
        Resume ExitHere
    End If
End Sub


'----------------------------------------------------------------
' Code on page 554
'----------------------------------------------------------------

Sub Create_StoredProc()
    Dim conn As ADODB.Connection

    Set conn = CurrentProject.Connection
    conn.Execute "CREATE PROCEDURE usp_EmpByFullName AS " & _
                 "SELECT * FROM vw_Employees " & _
                 "ORDER BY [Full Name];"
    Application.RefreshDatabaseWindow
    conn.Close
    Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 23-4
'----------------------------------------------------------------

Sub Create_SpWithParam()
    Dim conn As ADODB.Connection

    On Error GoTo ErrorHandler

    Set conn = CurrentProject.Connection

    conn.Execute "CREATE PROCEDURE usp_procEnterData " & _
        "(@Company TEXT (50), " & _
        "@Tel TEXT (25)) AS " & _
        "INSERT INTO Shippers (Company, [Business Phone]) " & _
        "VALUES (@Company, @Tel);"
    Application.RefreshDatabaseWindow
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    If InStr(1, Err.Description, "procEnterData") Then
        conn.Execute "DROP PROC procEnterData"
        Resume
    Else
        MsgBox Err.Number & ":" & Err.Description
        Resume ExitHere
    End If
End Sub


'----------------------------------------------------------------
' Code on page 558
'----------------------------------------------------------------

Sub RunProc_WithParam()
    Dim conn As ADODB.Connection
    
    Set conn = CurrentProject.Connection
    conn.Execute "usp_procEnterData ""My Company2"", ""(234) 334-3344"""
    conn.Close
    Set conn = Nothing
End Sub


'----------------------------------------------------------------
' Hands-On 23-5
'----------------------------------------------------------------

Sub Execute_StoredProcWithParam()
    Dim conn As ADODB.Connection
    Dim strCompany As String
    Dim strPhone As String
    
    On Error GoTo ErrorHandler
    
    Set conn = CurrentProject.Connection
    strCompany = InputBox("Please enter company name:", "Input Company")
    strPhone = InputBox("Please enter the phone number:", "Input Phone")
    
    If strCompany <> "" And strPhone <> "" Then
        conn.Execute "usp_procEnterData " & strCompany & ", " & strPhone
    End If
ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ":" & Err.Description
    Resume ExitHere
End Sub


'----------------------------------------------------------------
' Hands-On 23-6
'----------------------------------------------------------------

Sub Delete_StoredProc()
    Dim conn As ADODB.Connection
    
    On Error GoTo ErrorHandler
    
    Set conn = CurrentProject.Connection
    conn.Execute "DROP PROCEDURE usp_procEnterData; "

ExitHere:
    If Not conn Is Nothing Then
        If conn.State = adStateOpen Then conn.Close
    End If
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    If InStr(1, Err.Description, "cannot find") Then
        MsgBox "The procedure you want to delete " & _
            "does not exist.", _
            vbDefaultButton1 + vbInformation, "Request failed"
    Else
        MsgBox Err.Number & ":" & Err.Description
    End If
    Resume ExitHere
End Sub


