TransferCredits

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TransferCredits (Module)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

'User action
    Public Const applyTR As String = "Apply Transder Credits"
    Public Const populateTR As String = "Populate the student's courses"
    
'RGB for completed actions
    Const completedRed As Integer = 135
    Const completedGreen As Integer = 206
    Const completedBlue As Integer = 280

'AS400 specific values
    Const rowHome As Long = 19
    Const colHome As Long = 7
    Const startRow As Long = 17
    Const endRow As Long = 22
    Const selectCourse As Long = 1
    Const optionCustomerService As String = "1"
    Const optionEducationInquiry As String = "15"
    Const locationTR As String = "60211"
    Const actionCodeC As String = "I"
    Const applyCodeY As String = "Y"
    Const schoolCode As String = "H"

Public Sub PopulateCoursesFromAccount(ByRef CreditsForm As MSForms.UserForm, _
    ByVal AS400 As cAS400, ByRef Exception As cException)
    
    'Pass error handling up the call stack
    On Error GoTo 0
    Exception.Push "TransferCredits.PopulateCoursesFromAccount"
    
    Dim i As Integer
    Dim j As Long
    Dim SID As String
    
    Const maxSize As Integer = 30
    Dim textboxArray() As Object
    ReDim textboxArray(1 To maxSize, 1 To 2)
    
    SID = Trim(CreditsForm.SID_Textbox)
    
    Exception.ErrMessage = "Student ID: " & SID
    Exception.ErrMessage = "Navigating ..."
    
    Select Case AS400.GetText(1, 2, 8)
    
        Case "60210   ": AS400.SendKeys F3Key
        
        Case "603132_B": AS400.Pause
        
        Case Else
    
            NavigateHome AS400, Exception
            If ConfirmHomeScreen(AS400, Exception) = False Then GoTo NavigationFailure
            
            AS400.SetText optionCustomerService, rowHome, colHome
            AS400.SendKeys EnterKey
            
            AS400.SetText optionEducationInquiry, rowHome, colHome
            AS400.SendKeys EnterKey
            
    End Select

    AS400.SetText SID, 3, 13
    AS400.SendKeys EnterKey
    AS400.SendKeys F11Key
    
    Exception.ErrMessage = "Confirming location"
    If AS400.SearchText("60210", 1, 1, forward) = False Then GoTo NavigationFailure
    If Len(Trim(AS400.GetText(5, 23, modLength))) < 2 Then GoTo DoesNotExist
    
    LoadTextboxesFromCredits textboxArray(), CreditsForm, Exception
    
    With AS400
        
        Exception.ErrMessage = "Passing information from the AS/400 to the userform"
        i = 1
        Do While i <= maxSize
        
            For j = startRow To endRow
                
                Exception.ErrMessage = "... ... Course #" & CStr(i) & " Line #" & CStr(j)
                
                textboxArray(i, 1) = Trim(.GetText(j, 4, modLength))
                textboxArray(i, 2) = Trim(.GetText(j, 13, 30))
                
                i = i + 1
            
            Next j
        
            If Len(Trim(AS400.GetText(endRow, 4, 2))) = 0 Then
                Exception.ErrMessage = "... ... At the final page, exiting loop"
                Exit Do
            Else
                Exception.ErrMessage = "... ... Moving to the next page"
                .SendKeys "[pagedn]"
            End If
            
        Loop
    
    End With
    
    CreditsForm.AlphaName_Textbox = CheckString(AS400.GetText(4, 32, 38), 1)
    
'''''''''''''''''''''''''''
' Cleanup
'''''''''''''''''''''''''''
Cleanup:
    
    TurnOnExcelDefaults Exception
    Exception.Pop

Exit Sub

'''''''''''''''''''''''''''
' Error Handling
'''''''''''''''''''''''''''
NavigationFailure:

    With Exception
        .IsError = False
        .Flag = True
        .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
'''''''''''''''''''''''''''
DoesNotExist:

    With Exception
        .IsError = False
        .Flag = True
        .Throw "The course list on the given student account is empty."
    End With
    
GoTo Cleanup
'''''''''''''''''''''''''''
End Sub
'''''''''''''''''''''''''''

Public Sub ApplyTransferCredits(ByRef CreditsForm As MSForms.UserForm, _
    ByVal AS400 As cAS400, ByRef Exception As cException)
    
    'Pass error handling up the call stack
    On Error GoTo 0
    Exception.Push "TransferCredits.ApplyTransferCredits"
    
    Dim i As Integer
    Dim j As Long
    Dim TRcounter As Integer
    Dim SID As String
    Dim finalMessage As String
    
    Const maxSize As Integer = 30
    
    Dim bools() As Boolean
    ReDim bools(1 To maxSize)
    
    Dim textboxArray() As Object
    ReDim textboxArray(1 To maxSize, 1 To 2)
    
    SID = Trim(CreditsForm.SID_Textbox)
    finalMessage = "Transfer credits for SID: " & SID & " have been successfully applied."
    
    Exception.ErrMessage = "Student ID: " & SID
    Exception.ErrMessage = "Navigating"
    
    Select Case AS400.GetText(1, 2, 8)
    
        Case "60210   "
        
            With AS400
                .SendKeys F3Key
                .SendKeys F11Key
            End With
        
        Case "603132_B"
        
            AS400.SendKeys F11Key
        
        Case Else
        
            NavigateHome AS400, Exception
            If ConfirmHomeScreen(AS400, Exception) = False Then GoTo NavigationFailure
            
            With AS400
                .SetText optionCustomerService, rowHome, colHome
                .SendKeys EnterKey
            
                .SetText optionEducationInquiry, rowHome, colHome
                .SendKeys EnterKey
            
                .SetText SID, 3, 13
                .SendKeys EnterKey
                .SendKeys F11Key
            End With
            
            If AS400.SearchText("60210", 1, 1, forward) = False Then GoTo NavigationFailure
    
    End Select
    
    If AS400.SearchText(SID, 1, 1, forward) = False Then GoTo SIDNotAMatch
    
    LoadTextboxesFromCredits textboxArray(), CreditsForm, Exception
    LoadBools bools(), CreditsForm, Exception
    
    With AS400

        Exception.ErrMessage = "Selecting courses for transfer"
        i = 1
        Do While i <= maxSize
        
            For j = startRow To endRow
            
                Exception.ErrMessage = "... ... Course #" & CStr(i) & " Line #" & CStr(j)
            
                If bools(i) = True And Len(Trim(textboxArray(i, 1).Value)) > 1 Then
    
                    .SetText selectCourse, j, 2
                    textboxArray(i, 1).BackColor = RGB(completedRed, completedGreen, completedBlue)
                    textboxArray(i, 2).BackColor = RGB(completedRed, completedGreen, completedBlue)
                    
                    TRcounter = TRcounter + 1
                    
                    Exception.ErrMessage = "... ... A course has been added to the list (" & CStr(TRcounter) & ")"
                    
                End If
                
                i = i + 1
            
            Next j
        
            If Len(Trim(AS400.GetText(endRow, 4, 2))) = 0 Then
                Exit Do
            Else
                .SendKeys "[pagedn]"
            End If
            
        Loop
    
    End With

    If TRcounter <> 0 Then
    
        If AS400.SearchText(locationTR, 1, 1, forward) Then GoTo NavigationFailure

        With AS400
        
            Exception.ErrMessage = "Applying transfer credits to the selected courses"
            Do Until TRcounter <= 0
            
                Exception.ErrMessage = "... ... Courses remaining: " & CStr(TRcounter)

                .SetText actionCodeC, 3, 19
                .SetText applyCodeY, 8, 19
                .SetText schoolCode, 10, 19
                
                .SendKeys EnterKey
                .SendKeys F3Key
                
                TRcounter = TRcounter - 1

            Loop
        
            Exception.ErrMessage = "Setting the student account to acknowledge the applied TR"
            .SetText actionCodeC, 3, 23
            .SetText applyCodeY, 14, 60
            .SendKeys EnterKey
            .SendKeys F3Key
            
            MsgBox finalMessage, vbInformation, "Transfer Credits"
        
        End With
        
    Else
    
        Exception.ErrMessage = "No courses have been selected for transfer"
        AS400.SendKeys F3Key
        MsgBox "No class has been selected for transfer", vbInformation, "Transfer Credits"
        
    End If

'''''''''''''''''''''''''''
' Cleanup
'''''''''''''''''''''''''''
Cleanup:
    
    TurnOnExcelDefaults Exception
    Exception.Pop

Exit Sub

'''''''''''''''''''''''''''
' Error Handling
'''''''''''''''''''''''''''
NavigationFailure:

    With Exception
        .IsError = False
        .Flag = True
        .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
'''''''''''''''''''''''''''
SIDNotAMatch:

    With Exception
        .IsError = False
        .Flag = True
        .Throw "The selected Student ID# has changed since starting the procedure.  " & _
                    "The procedure has been cancelled." & vbNewLine & vbNewLine & _
                    "Please ensure the Student ID# is correct before proceeding."
    End With

GoTo Cleanup
'''''''''''''''''''''''''''
End Sub
'''''''''''''''''''''''''''
    
Private Sub LoadTextboxesFromCredits(ByRef textboxArray() As Object, _
    ByVal CreditsForm As MSForms.UserForm, ByRef Exception As cException)
    
    On Error Resume Next
    Exception.Push "TransferCredits.LoadTextboxesFromCredits"
    
    With CreditsForm
        Set textboxArray(1, 1) = .Mod1_Textbox
        Set textboxArray(2, 1) = .Mod2_Textbox
        Set textboxArray(3, 1) = .Mod3_Textbox
        Set textboxArray(4, 1) = .Mod4_Textbox
        Set textboxArray(5, 1) = .Mod5_Textbox
        Set textboxArray(6, 1) = .Mod6_Textbox
        Set textboxArray(7, 1) = .Mod7_Textbox
        Set textboxArray(8, 1) = .Mod8_Textbox
        Set textboxArray(9, 1) = .Mod9_Textbox
        Set textboxArray(10, 1) = .Mod10_Textbox
        Set textboxArray(11, 1) = .Mod11_Textbox
        Set textboxArray(12, 1) = .Mod12_Textbox
        Set textboxArray(13, 1) = .Mod13_Textbox
        Set textboxArray(14, 1) = .Mod14_Textbox
        Set textboxArray(15, 1) = .Mod15_Textbox
        Set textboxArray(16, 1) = .Mod16_Textbox
        Set textboxArray(17, 1) = .Mod17_Textbox
        Set textboxArray(18, 1) = .Mod18_Textbox
        Set textboxArray(19, 1) = .Mod19_Textbox
        Set textboxArray(20, 1) = .Mod20_Textbox
        Set textboxArray(21, 1) = .Mod21_Textbox
        Set textboxArray(22, 1) = .Mod22_Textbox
        Set textboxArray(23, 1) = .Mod23_Textbox
        Set textboxArray(24, 1) = .Mod24_Textbox
        Set textboxArray(25, 1) = .Mod25_Textbox
        Set textboxArray(26, 1) = .Mod26_Textbox
        Set textboxArray(27, 1) = .Mod27_Textbox
        Set textboxArray(28, 1) = .Mod28_Textbox
        Set textboxArray(29, 1) = .Mod29_Textbox
        Set textboxArray(30, 1) = .Mod30_Textbox
        
        Set textboxArray(1, 2) = .Title1_Textbox
        Set textboxArray(2, 2) = .Title2_Textbox
        Set textboxArray(3, 2) = .Title3_Textbox
        Set textboxArray(4, 2) = .Title4_Textbox
        Set textboxArray(5, 2) = .Title5_Textbox
        Set textboxArray(6, 2) = .Title6_Textbox
        Set textboxArray(7, 2) = .Title7_Textbox
        Set textboxArray(8, 2) = .Title8_Textbox
        Set textboxArray(9, 2) = .Title9_Textbox
        Set textboxArray(10, 2) = .Title10_Textbox
        Set textboxArray(11, 2) = .Title11_Textbox
        Set textboxArray(12, 2) = .Title12_Textbox
        Set textboxArray(13, 2) = .Title13_Textbox
        Set textboxArray(14, 2) = .Title14_Textbox
        Set textboxArray(15, 2) = .Title15_Textbox
        Set textboxArray(16, 2) = .Title16_Textbox
        Set textboxArray(17, 2) = .Title17_Textbox
        Set textboxArray(18, 2) = .Title18_Textbox
        Set textboxArray(19, 2) = .Title19_Textbox
        Set textboxArray(20, 2) = .Title20_Textbox
        Set textboxArray(21, 2) = .Title21_Textbox
        Set textboxArray(22, 2) = .Title22_Textbox
        Set textboxArray(23, 2) = .Title23_Textbox
        Set textboxArray(24, 2) = .Title24_Textbox
        Set textboxArray(25, 2) = .Title25_Textbox
        Set textboxArray(26, 2) = .Title26_Textbox
        Set textboxArray(27, 2) = .Title27_Textbox
        Set textboxArray(28, 2) = .Title28_Textbox
        Set textboxArray(29, 2) = .Title29_Textbox
        Set textboxArray(30, 2) = .Title30_Textbox
    End With
    
    Exception.Pop
    
End Sub

Private Sub LoadBools(ByRef bools() As Boolean, _
    ByVal CreditsForm As MSForms.UserForm, ByRef Exception As cException)
    
    On Error Resume Next
    Exception.Push "TransferCredits.LoadBools"
    
    With CreditsForm
        
        bools(1) = .Class1_Checkbox.Value
        bools(2) = .Class2_Checkbox.Value
        bools(3) = .Class3_Checkbox.Value
        bools(4) = .Class4_Checkbox.Value
        bools(5) = .Class5_Checkbox.Value
        bools(6) = .Class6_Checkbox.Value
        bools(7) = .Class7_Checkbox.Value
        bools(8) = .Class8_Checkbox.Value
        bools(9) = .Class9_Checkbox.Value
        bools(10) = .Class10_Checkbox.Value
        bools(11) = .Class11_Checkbox.Value
        bools(12) = .Class12_Checkbox.Value
        bools(13) = .Class13_Checkbox.Value
        bools(14) = .Class14_Checkbox.Value
        bools(15) = .Class15_Checkbox.Value
        bools(16) = .Class16_Checkbox.Value
        bools(17) = .Class17_Checkbox.Value
        bools(18) = .Class18_Checkbox.Value
        bools(19) = .Class19_Checkbox.Value
        bools(20) = .Class20_Checkbox.Value
        bools(21) = .Class21_Checkbox.Value
        bools(22) = .Class22_Checkbox.Value
        bools(23) = .Class23_Checkbox.Value
        bools(24) = .Class24_Checkbox.Value
        bools(25) = .Class25_Checkbox.Value
        bools(26) = .Class26_Checkbox.Value
        bools(27) = .Class27_Checkbox.Value
        bools(28) = .Class28_Checkbox.Value
        bools(29) = .Class29_Checkbox.Value
        bools(30) = .Class30_Checkbox.Value
        
    End With
    
    Exception.Pop
    
End Sub