Main

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Main (Module)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Contains the primary execution procedures for the application's various features
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

'Activate/Deactivates the primary error handling
    Public Const DebugFlag As Boolean = True        'False for error handling; True for no error handling

'Value containers
    Public Const noEntry As String = "No Entry"     'As a procedure argument
    Public rngStudentID As Excel.Range              'For info to pass from userform to userform
    Public rnglastSession As Excel.Range            'For info to pass from userform to userform
    
'AS/400 static values (required by IBM to be set as Long)
    Public Const addTime As Long = 10               'In Milliseconds; cAS400 defaults this to "1"
    Public gv_WaitAdd As Long                       'For adding milliseconds within the cAS400 module
    Public Const modLength As Long = 8              'Course "mods" and Student ID numbers are always 8 digits long
    Public Const forward As Long = 1                'For cAS400.SearchText, as per AS/400 method requirement
    Public Const reverse As Long = 2                'For cAS400.SearchText, as per AS/400 method requirement
    Public Const EnterKey As String = "[Enter]"     'For cAS400.SendKeys; Enter keypress
    Public Const F1Key As String = "[pf1]"          'For cAS400.SendKeys; F-Key keypress
    Public Const F2Key As String = "[pf2]"          'For cAS400.SendKeys; F-Key keypress
    Public Const F3Key As String = "[pf3]"          'For cAS400.SendKeys; F-Key keypress
    Public Const F4Key As String = "[pf4]"          'For cAS400.SendKeys; F-Key keypress
    Public Const F5Key As String = "[pf5]"          'For cAS400.SendKeys; F-Key keypress
    Public Const F6Key As String = "[pf6]"          'For cAS400.SendKeys; F-Key keypress
    Public Const F7Key As String = "[pf7]"          'For cAS400.SendKeys; F-Key keypress
    Public Const F8Key As String = "[pf8]"          'For cAS400.SendKeys; F-Key keypress
    Public Const F9Key As String = "[pf9]"          'For cAS400.SendKeys; F-Key keypress
    Public Const F10Key As String = "[pf10]"        'For cAS400.SendKeys; F-Key keypress
    Public Const F11Key As String = "[pf11]"        'For cAS400.SendKeys; F-Key keypress
    Public Const F12Key As String = "[pf12]"        'For cAS400.SendKeys; F-Key keypress
    Public Const PageUpKey As String = "[pageup]"   'For cAS400.SendKeys; PageUp keypress
    Public Const PageDownKey As String = "[pagedn]" 'For cAS400.SendKeys; PageDown keypress
    Public Const messageMustSignIn As String = "Please log into the AS/400 again before proceeding"

'When printing to the immediate window
    Public Const windowLineSeperator As String = vbNewLine & _
        "||***************************************************||" & vbNewLine

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' RunRegistration
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub RunRegistration(ByRef RegForm As MSForms.UserForm)

    '''''''''''''''''''''''''''
    ' Declarations
    '''''''''''''''''''''''''''
    Dim finalMessage As String                  'For dialogue prompt at the end of the procedure
    Dim Exception As cException                 'Stores the error and stack information
    Dim Student As cStudent                     'Stores the student and userform information
    Dim AS400 As cAS400                         'Stores the AS/400 objects and methods
    Dim StatusBox As Object                     'Stores reference to the userform's status textbox
                        
    Set Exception = New cException
    Set Student = New cStudent
    Set AS400 = New cAS400
    Set StatusBox = RegForm.Status_Textbox

    '''''''''''''''''''''''''''
    ' Settings
    '''''''''''''''''''''''''''
    With Exception
        .ErrMessage = "" & vbNewLine
        .ErrMessage = windowLineSeperator
        .Push "Main.RunRegistration"
    End With
    
    StatusBox.Value = "...   ...   ...   Performing the pre-enrollment checks   ...   ...   ..."

    TurnOffExcelDefaults Exception
    
    '''''''''''''''''''''''''''
    ' Load objects
    '''''''''''''''''''''''''''
    If DebugFlag Then On Error GoTo 0 Else On Error GoTo UserformError
    LoadUserformObjects Student, RegForm, Exception
    
    If DebugFlag Then On Error GoTo 0 Else On Error GoTo AS400Error
    AS400.InitializeApp Student.GetSession, Exception, addTime
    
    rnglastSession = Student.GetSession
    
    '''''''''''''''''''''''''''
    ' Pre-enrollment check
    '''''''''''''''''''''''''''
    If DebugFlag Then On Error GoTo 0 Else On Error GoTo ErrorOnEnrollmentCheck
    If ApproveRegistration(Student, Exception) = False Then
        GoTo Cleanup
    End If
    
    Exception.ErrMessage = "Registration has been approved by the user"
    StatusBox.Value = "...   ...   ...   Performing Enrollment (Please Wait)   ...   ...   ..."
    
    '''''''''''''''''''''''''''
    ' Core Execution
    '''''''''''''''''''''''''''
    If DebugFlag Then On Error GoTo 0 Else On Error GoTo ErrorOnEnrollmentCheck
    
    RegisterToAddressBook Student, AS400, Exception
    If Exception.Flag Then GoTo NavigationFailure
    
    MsgBox Student.StudentID
    
    RegisterToProgramEntry Student, AS400, Exception
    If Exception.Flag Then GoTo NavigationFailure
    
    StatusBox.Value = "...   ...   ...  (Please Wait)  ...   ...   ..."
    rngStudentID = Student.StudentID
    
    '''''''''''''''''''''''''''
    ' Message and next procedure
    '''''''''''''''''''''''''''
    Exception.ErrMessage = "Presenting dialogue box"
    
    finalMessage = "The student has been successfully registered." & vbNewLine & vbNewLine & _
                        vbTab & "Student ID#: " & CStr(Student.StudentID) & vbNewLine & vbNewLine & _
                        "DO YOU WISH TO APPLY TRANSFER CREDITS?"
    
    If MsgBox(finalMessage, vbYesNo, "Procedure complete - Apply TR?") = vbYes Then
    
        form_TransferCredits.Show
        
    Else
    
        MsgBox "The procedure has ended", vbInformation, "Thank you for using the TaskHelper"
        
    End If
    
'''''''''''''''''''''''''''
' Cleanup
'''''''''''''''''''''''''''
Cleanup:

    TurnOnExcelDefaults Exception
    Exception.Pop

Exit Sub
'''''''''''''''''''''''''''
' Error Handling
'''''''''''''''''''''''''''
UserformError:

    With Exception
        .ErrNumber = Err.Number
        .ErrDescription = Err.Description
        .IsError = True
        .Throw "An issue occurred while pulling information from the userform." & vbNewLine & vbNewLine & _
                    "Resolution: Unavailable"
    End With
    
Resume Cleanup
'''''''''''''''''''''''''''
AS400Error:

    With Exception
        .ErrNumber = Err.Number
        .ErrDescription = Err.Description
        .IsError = True
        .Throw "Please ensure the AS/400 is active and on the correct screen before proceeding."
    End With
    
Resume Cleanup
'''''''''''''''''''''''''''
ErrorOnEnrollmentCheck:

    With Exception
        .ErrNumber = Err.Number
        .ErrDescription = Err.Description
        .IsError = True
        .Throw "An error has occurred while performing the pre-enrollment check." & vbNewLine & vbNewLine & _
                    "Resolution: Unavailable"
    End With
    
Resume Cleanup
'''''''''''''''''''''''''''
NavigationFailure:

    With Exception
        .IsError = False
        .Throw "An issue has occurred: The AS/400 has not found the correct screen location.  " & _
                    "The procedure has been cancelled." & vbNewLine & vbNewLine & _
                    "Please ensure the AS/400 is on the correct session, " & _
                    "and on a friendly screen location, before proceeding."
    End With
    
GoTo Cleanup
'''''''''''''''''''''''''''
End Sub
'''''''''''''''''''''''''''

Public Sub RunSearchButton(ByVal action_type As String, ByRef NameForm As MSForms.UserForm, _
    Optional ByVal page_to_keypress As String, Optional ByVal session_letter As String = noEntry)
    
    '''''''''''''''''''''''''''
    ' Declarations
    '''''''''''''''''''''''''''
    Dim Exception As cException                 'Stores the error and stack information
    Dim Student As cStudent                     'Stores the student and userform information
    Dim AS400 As cAS400                         'Stores the AS/400 objects and methods
    Dim StatusBox As Object                     'Stores reference to the userform's status textbox
    
    Set Exception = New cException
    Set Student = New cStudent
    Set AS400 = New cAS400
    Set StatusBox = NameForm.Status_Textbox
    
    '''''''''''''''''''''''''''
    ' Settings
    '''''''''''''''''''''''''''
    With Exception
        .ErrMessage = "" & vbNewLine
        .ErrMessage = windowLineSeperator
        .Push "Main.RunSearchButton"
    End With
    
    StatusBox.Value = "...   ...   ...   Searching name   ...   ...   ..."

    TurnOffExcelDefaults Exception
    
    If session_letter = noEntry Then
        Set Student.SessionComboBox = NameForm.Session_ComboBox
        session_letter = Student.GetSession
    End If
    
    rnglastSession = session_letter
    
    '''''''''''''''''''''''''''
    ' Load objects
    '''''''''''''''''''''''''''
    If DebugFlag Then On Error GoTo 0 Else On Error GoTo ProceduresError
    PrepareNameSearchTextboxes NameForm, Exception
    StoreSettingsForNameSearches Student, NameForm, Exception
    
    If DebugFlag Then On Error GoTo 0 Else On Error GoTo AS400Error
    AS400.InitializeApp session_letter, Exception, 1

    '''''''''''''''''''''''''''
    ' Core Execution
    '''''''''''''''''''''''''''
    Exception.ErrMessage = "Performing actions based on which button is selected"
    
    Select Case action_type
    
        Case buttonPrimary
        
            NavigateToNameSearch AS400, Exception
            If Exception.Flag = True Then GoTo NavigationFailure
            
            AS400.SetText Student.GetAlphaName, 4, 20
            AS400.SendKeys EnterKey
            
            SearchNameFromPrimaryButton Student, AS400, Exception
            
        Case buttonAction
        
            If AS400.SearchText(nameSearchTag, 1, 1) = False Then GoTo NavigationFailure
            AS400.SendKeys page_to_keypress
            
            SearchNameFromPrimaryButton Student, AS400, Exception
            
        Case buttonMulti
        
            If UserHasSelectedName(AS400, NameForm, Exception) = False Then
            
                If AS400.SearchText("01NS", 1, 1, forward) = False Then
                
                    NavigateToNameSearch AS400, Exception
                    If Exception.Flag = True Then GoTo NavigationFailure
                
                End If
            
                AS400.SetText NameForm.AlphaName_Textbox, 4, 20
                AS400.SendKeys EnterKey
                SearchNameFromPrimaryButton Student, AS400, Exception
                
            End If
            
            ClearActionBoxes NameForm, Exception
    
    End Select
    
    NameForm.AlphaName_Textbox = vbNullString
    
'''''''''''''''''''''''''''
' Cleanup
'''''''''''''''''''''''''''
Cleanup:

    TurnOnExcelDefaults Exception
    Exception.Pop

Exit Sub
'''''''''''''''''''''''''''
' Error Handling
'''''''''''''''''''''''''''
ProceduresError:

    With Exception
        .ErrNumber = Err.Number
        .ErrDescription = Err.Description
        .IsError = True
        .Throw "An unexpected error has occurred."
    End With
    
Resume Cleanup
'''''''''''''''''''''''''''
AS400Error:

    With Exception
        .ErrNumber = Err.Number
        .ErrDescription = Err.Description
        .IsError = True
        .Throw "Please ensure the AS/400 is active and on the correct screen before proceeding."
    End With
    
Resume Cleanup
'''''''''''''''''''''''''''
NavigationFailure:

    With Exception
        .IsError = False
        .Throw "An issue has occurred: The AS/400 has not found the correct screen location.  " & _
                    "The procedure has been cancelled." & vbNewLine & vbNewLine & _
                    "Please ensure the AS/400 is on the correct session, " & _
                    "and on a friendly screen location, before proceeding."
    End With
    
GoTo Cleanup
'''''''''''''''''''''''''''
End Sub
'''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' RunTransferProcedures
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub RunTransferProcedures(ByRef CreditsForm As MSForms.UserForm, ByVal action_type As String)
    
    '''''''''''''''''''''''''''
    ' Declarations
    '''''''''''''''''''''''''''
    Dim finalMessage As String
    Dim Exception As cException                 'Stores the error and stack information
    Dim AS400 As cAS400                         'Stores the AS/400 objects and methods
    Dim StatusBox As Object                     'Stores reference to the userform's status textbox

    Set Exception = New cException
    Set AS400 = New cAS400
    Set StatusBox = CreditsForm.Status_Textbox
    
    '''''''''''''''''''''''''''
    ' Settings
    '''''''''''''''''''''''''''
    With Exception
        .ErrMessage = "" & vbNewLine
        .ErrMessage = windowLineSeperator
        .Push "Main.RunTransferProcedures"
    End With
    
    TurnOffExcelDefaults Exception
    
    If Len(Trim(CreditsForm.SID_Textbox)) < 1 Then GoTo SIDNotValid
    rngStudentID = CreditsForm.SID_Textbox
    
    StatusBox = "...   ...   ...   Applying TR   ...   ...   ..."
    
    '''''''''''''''''''''''''''
    ' Load objects
    '''''''''''''''''''''''''''
    If DebugFlag Then On Error GoTo 0 Else On Error GoTo AS400Error
    AS400.InitializeApp Trim(CreditsForm.Session_ComboBox.Value), Exception, 10
    
    '''''''''''''''''''''''''''
    ' Core Execution
    '''''''''''''''''''''''''''
    If action_type = populateTR Then
    
        PopulateCoursesFromAccount CreditsForm, AS400, Exception
        
        If Exception.Flag = True Then GoTo ExceptionHasBeenThrown
        
    ElseIf action_type = applyTR Then
    
        ApplyTransferCredits CreditsForm, AS400, Exception
        
        If Exception.Flag = True Then GoTo ExceptionHasBeenThrown

        Exception.ErrMessage = "Presenting dialogue box"
    
        finalMessage = "The Transfer Credits procedure has completed successfully." & vbNewLine & vbNewLine & _
                        "Do you wish to view the Shipments Form?"
    
        If MsgBox(finalMessage, vbYesNo, "Procedure complete - Apply TR?") = vbYes Then
    
            form_Shipments.Show

        End If
        
    End If

'''''''''''''''''''''''''''
' Cleanup
'''''''''''''''''''''''''''
Cleanup:

    TurnOnExcelDefaults Exception
    Exception.Pop
    
Exit Sub
'''''''''''''''''''''''''''
' Error Handling
'''''''''''''''''''''''''''
AS400Error:

    With Exception
        .ErrNumber = Err.Number
        .ErrDescription = Err.Description
        .IsError = True
        .Throw "Please ensure the AS/400 is active and on the correct screen before proceeding."
    End With
    
Resume Cleanup
'''''''''''''''''''''''''''
ExceptionHasBeenThrown:

    'Error Message provided within the child procedure
    
GoTo Cleanup
'''''''''''''''''''''''''''
SIDNotValid:

    With Exception
        .IsError = False
        .Throw "The selected Student ID# is invalid." & vbNewLine & vbNewLine & _
                    "Please enter a valid Student ID# before proceeding."
    End With
    
GoTo Cleanup
'''''''''''''''''''''''''''
End Sub
'''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' RunShipmentSelection
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub RunShipmentSelection(ByRef ShipForm As MSForms.UserForm, ByVal send_Shipments As Boolean)
    
    '''''''''''''''''''''''''''
    ' Declarations
    '''''''''''''''''''''''''''
    Dim finalMessage As String
    Dim Exception As cException                 'Stores the error and stack information
    Dim AS400 As cAS400                         'Stores the AS/400 objects and methods
    Dim StatusBox As Object                     'Stores reference to the userform's status textbox

    Set Exception = New cException
    Set AS400 = New cAS400
    Set StatusBox = ShipForm.Status_Textbox
    
    '''''''''''''''''''''''''''
    ' Settings
    '''''''''''''''''''''''''''
    With Exception
        .ErrMessage = "" & vbNewLine
        .ErrMessage = windowLineSeperator
        .Push "Main.RunShipmentSelection"
    End With
    
    TurnOffExcelDefaults Exception
    
    If Len(Trim(ShipForm.SID_Textbox)) < 1 Then GoTo SIDNotValid
    rngStudentID = ShipForm.SID_Textbox
    
    StatusBox = "...   ...   ...   Processing Shipments   ...   ...   ..."
    
    '''''''''''''''''''''''''''
    ' Load objects
    '''''''''''''''''''''''''''
    If DebugFlag Then On Error GoTo 0 Else On Error GoTo AS400Error
    AS400.InitializeApp Trim(ShipForm.Session_ComboBox.Value), Exception, 10
    
    '//
    If AS400.IsInhibited = True Then MsgBox "Inhibited"
    '//
    
    '''''''''''''''''''''''''''
    ' Core Execution
    '''''''''''''''''''''''''''
    If send_Shipments Then
        
        ReleaseAllShipments ShipForm, AS400, Exception
        
        If Exception.Flag = True Then GoTo ExceptionHasBeenThrown
        
    ElseIf send_Shipments = False Then
    
        StopAllShipments ShipForm, AS400, Exception
    
    End If
    
'''''''''''''''''''''''''''
' Cleanup
'''''''''''''''''''''''''''
Cleanup:
    
    TurnOnExcelDefaults Exception
    Exception.Pop
    
Exit Sub
'''''''''''''''''''''''''''
' Error Handling
'''''''''''''''''''''''''''
AS400Error:

    With Exception
        .ErrNumber = Err.Number
        .ErrDescription = Err.Description
        .IsError = True
        .Throw "Please ensure the AS/400 is active and on the correct screen before proceeding."
    End With
    
Resume Cleanup
'''''''''''''''''''''''''''
SIDNotValid:

    With Exception
        .IsError = False
        .Throw "The selected Student ID# is invalid." & vbNewLine & vbNewLine & _
                    "Please enter a valid Student ID# before proceeding."
    End With
    
GoTo Cleanup
'''''''''''''''''''''''''''
ExceptionHasBeenThrown:

    'Error Message provided within the child procedure
    
GoTo Cleanup
'''''''''''''''''''''''''''
End Sub
'''''''''''''''''''''''''''