


Private Sub Command184_Click()
On Error GoTo Err_Q_R_Click

    Dim stDocName As String
    Dim stLinkCriteria As String

    stDocName = "Q / R"
    DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Q_R_Click:
    Exit Sub

Err_Q_R_Click:
    MsgBox Err.Description
    Resume Exit_Q_R_Click
End Sub

Private Sub Completion_Date_AfterUpdate()

End Sub

Private Sub Delete_Click()
On Error GoTo Err_Delete_Click


    DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
    DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

Exit_Delete_Click:
    Exit Sub

Err_Delete_Click:
    MsgBox Err.Description
    Resume Exit_Delete_Click
    
End Sub
Private Sub Exit_Click()
On Error GoTo Err_Exit_Click


    DoCmd.CLOSE

Exit_Exit_Click:
    Exit Sub

Err_Exit_Click:
    MsgBox Err.Description
    Resume Exit_Exit_Click
    
End Sub

Private Sub Form_AfterUpdate()



End Sub

Private Sub Form_Current()
Update_Status
'If Out_Date_Forwarded1 And Out_Date_Forwarded1 <= (Now) Then
'                Dim i As Integer
'                i = (Me.In_Date_Recieved) - Me.Out_Date_Forwarded1
'                Out_Period1_1 = i
'                Select Case i
'                    Case Is <= 1
'                        Out_Status1_1.BackColor = 32768
'                    Case Is <= 2
'                        Out_Status1_1.BackColor = 33023
'                    Case Is <= 3
'                        Out_Status1_1.BackColor = 255
'                    Case Is >= 3
'                        Out_Status1_1.BackColor = 0
'                End Select
'            Else
'            Out_Status1_1.BackColor = 16777215
'
'       End If
'
'If Out_Date_Forwarded2 And Out_Date_Forwarded2 <= (Now) Then
'                Dim j As Integer
'                j = (Now) - Me.Out_Date_Forwarded2
'                Out_Period2 = j
'                Select Case j
'                    Case Is <= 7
'                        Out_Status2.BackColor = 32768
'                    Case 8 To 14
'                        Out_Status2.BackColor = 33023
'                    Case 15 To 31
'                        Out_Status2.BackColor = 255
'                    Case Is > 31
'                        Out_Status2.BackColor = 0
'                End Select
'            Else
'            Out_Status2.BackColor = 16777215
'
'       End If
'
'If In_Date_Recieved And In_Date_Recieved <= (Now) Then
'                Dim k As Integer
'                k = (Now) - Me.In_Date_Recieved
'                In_Period3 = k
'                Select Case k
'                    Case Is <= 1
'                        In_Status3.BackColor = 32768
'                    Case Is <= 2
'                        In_Status3.BackColor = 33023
'                    Case Is <= 3
'                        In_Status3.BackColor = 255
'                    Case Is >= 3
'                        In_Status3.BackColor = 0
'                End Select
'            Else
'            In_Status3.BackColor = 16777215
'
'       End If
End Sub

Private Sub Form_Load()
Update_Status
'If Out_Date_Forwarded1 And Out_Date_Forwarded1 <= (Now) Then
'                Dim i As Integer
'                i = (Me.In_Date_Recieved) - Me.Out_Date_Forwarded1
'                Out_Period1_1 = i
'                Select Case i
'                    Case Is <= 1
'                        Out_Status1_1.BackColor = 32768
'                    Case Is <= 2
'                        Out_Status1_1.BackColor = 33023
'                    Case Is <= 3
'                        Out_Status1_1.BackColor = 255
'                    Case Is >= 3
'                        Out_Status1_1.BackColor = 0
'                End Select
'            Else
'            Out_Status1_1.BackColor = 16777215
'
'       End If
'
'If Out_Date_Forwarded2 And Out_Date_Forwarded2 <= (Now) Then
'                Dim j As Integer
'                j = (Now) - Me.Out_Date_Forwarded2
'                Out_Period2 = j
'                Select Case j
'                    Case Is <= 7
'                        Out_Status2.BackColor = 32768
'                    Case 8 To 14
'                        Out_Status2.BackColor = 33023
'                    Case 15 To 31
'                        Out_Status2.BackColor = 255
'                    Case Is > 31
'                        Out_Status2.BackColor = 0
'                End Select
'            Else
'            Out_Status2.BackColor = 16777215
'
'       End If
'
'If In_Date_Recieved And In_Date_Recieved <= (Now) Then
'                Dim k As Integer
'                k = (Now) - Me.In_Date_Recieved
'                In_Period3 = k
'                Select Case k
'                    Case Is <= 1
'                        In_Status3.BackColor = 32768
'                    Case Is <= 2
'                        In_Status3.BackColor = 33023
'                    Case Is <= 3
'                        In_Status3.BackColor = 255
'                    Case Is >= 3
'                        In_Status3.BackColor = 0
'                End Select
'            Else
'            In_Status3.BackColor = 16777215
'
'       End If

End Sub

Private Sub In_Date_Recieved_AfterUpdate()
Update_Status
'If In_Date_Recieved And In_Date_Recieved <= (Now) Then
'                Dim k As Integer
'                k = (Now) - Me.In_Date_Recieved
'                In_Period3 = k
'                Select Case k
'                    Case Is <= 1
'                        In_Status3.BackColor = 32768
'                    Case Is <= 2
'                        In_Status3.BackColor = 33023
'                    Case Is <= 3
'                        In_Status3.BackColor = 255
'                    Case Is >= 3
'                        In_Status3.BackColor = 0
'                End Select
'            Else
 '           In_Status3.BackColor = 16777215

'       End If
End Sub

Private Sub In_Period3_AfterUpdate()

End Sub

Private Sub In_Status3_Change()

End Sub

Private Sub Last_Click()
On Error GoTo Err_Last_Click


    DoCmd.GoToRecord , , acLast

Exit_Last_Click:
    Exit Sub

Err_Last_Click:
    MsgBox Err.Description
    Resume Exit_Last_Click
    
End Sub
Private Sub First_Click()
On Error GoTo Err_First_Click


    DoCmd.GoToRecord , , acFirst

Exit_First_Click:
    Exit Sub

Err_First_Click:
    MsgBox Err.Description
    Resume Exit_First_Click
    
End Sub

Private Sub Out_Date_Forwarded1_AfterUpdate()
Update_Status
'If Out_Date_Forwarded1 And Out_Date_Forwarded1 <= (Now) Then
'                Dim i As Integer
'                i = (Me.In_Date_Recieved) - Me.Out_Date_Forwarded1
'                Out_Period1_1 = i
'                Select Case i
'                    Case Is <= 1
'                        Out_Status1_1.BackColor = 32768
'                    Case Is <= 2
'                        Out_Status1_1.BackColor = 33023
'                    Case Is <= 3
'                        Out_Status1_1.BackColor = 255
'                    Case Is >= 3
'                        Out_Status1_1.BackColor = 0
'                End Select
'            Else
'            Out_Status1_1.BackColor = 16777215
'
'       End If
End Sub
Private Sub Out_Date_Forwarded2_AfterUpdate()
Update_Status
'If Out_Date_Forwarded2 And Out_Date_Forwarded2 <= (Now) Then
'                Dim j As Integer
'                j = (Now) - Me.Out_Date_Forwarded2
'                Out_Period2 = j
'                Select Case j
'                    Case Is <= 7
'                        Out_Status2.BackColor = 32768
'                    Case 8 To 14
'                        Out_Status2.BackColor = 33023
'                    Case 15 To 31
'                        Out_Status2.BackColor = 255
'                    Case Is > 31
'                        Out_Status2.BackColor = 0
'                End Select
'            Else
'            Out_Status2.BackColor = 16777215
'
'       End If
End Sub

Private Sub Out_Period1_1_Dirty(Cancel As Integer)

End Sub

Private Sub Out_Period2_AfterUpdate()

End Sub

Private Sub Out_Reference1_DblClick(Cancel As Integer)
    On Error Resume Next
    Out_Reference1 = NewRef
End Sub

Private Sub Previous_Click()
On Error GoTo Err_Previous_Click


    DoCmd.GoToRecord , , acPrevious

Exit_Previous_Click:
    Exit Sub

Err_Previous_Click:
    MsgBox Err.Description
    Resume Exit_Previous_Click
    
End Sub
Private Sub Next_Click()
On Error GoTo Err_Next_Click


    DoCmd.GoToRecord , , acNext

Exit_Next_Click:
    Exit Sub

Err_Next_Click:
    MsgBox Err.Description
    Resume Exit_Next_Click
    
End Sub
Private Sub Find_Click()
On Error GoTo Err_Find_Click


    Screen.PreviousControl.SetFocus
    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70

Exit_Find_Click:
    Exit Sub

Err_Find_Click:
    MsgBox Err.Description
    Resume Exit_Find_Click
    
End Sub
Private Sub Command68_Click()
On Error GoTo Err_Command68_Click

    Dim stDocName As String

    stDocName = "Print Memo"
    DoCmd.OpenReport stDocName, acNormal

Exit_Command68_Click:
    Exit Sub

Err_Command68_Click:
    MsgBox Err.Description
    Resume Exit_Command68_Click
    
End Sub

Private Sub Q_R_Click()
On Error GoTo Err_Q_R_Click

    Dim stDocName As String
    Dim stLinkCriteria As String

    stDocName = "Q / R"
    DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Q_R_Click:
    Exit Sub

Err_Q_R_Click:
    MsgBox Err.Description
    Resume Exit_Q_R_Click
    
End Sub
Private Sub New_Memo_Click()
On Error GoTo Err_New_Memo_Click


    DoCmd.GoToRecord , , acNewRec

Exit_New_Memo_Click:
    Exit Sub

Err_New_Memo_Click:
    MsgBox Err.Description
    Resume Exit_New_Memo_Click
    
End Sub
Private Sub Add_New_Memo_Click()
On Error GoTo Err_Add_New_Memo_Click


    DoCmd.GoToRecord , , acNewRec

Exit_Add_New_Memo_Click:
    Exit Sub

Err_Add_New_Memo_Click:
    MsgBox Err.Description
    Resume Exit_Add_New_Memo_Click
    
End Sub
Private Sub Command143_Click()
On Error GoTo Err_Command143_Click

    Dim stDocName As String

    stDocName = "Print Memo"
    DoCmd.SendObject acReport, stDocName

Exit_Command143_Click:
    Exit Sub

Err_Command143_Click:
    MsgBox Err.Description
    Resume Exit_Command143_Click
    
End Sub
Private Sub Command144_Click()
On Error GoTo Err_Command144_Click

    Dim stDocName As String

    stDocName = "R_Memo_Print_2"
    DoCmd.OpenReport stDocName, acNormal

Exit_Command144_Click:
    Exit Sub

Err_Command144_Click:
    MsgBox Err.Description
    Resume Exit_Command144_Click
    
End Sub
Private Sub Command145_Click()
On Error GoTo Err_Command145_Click

    Dim stDocName As String

    stDocName = "R_Memo_Print_2"
    DoCmd.OpenReport stDocName, acPreview

Exit_Command145_Click:
    Exit Sub

Err_Command145_Click:
    MsgBox Err.Description
    Resume Exit_Command145_Click
    
End Sub
Private Sub Preview_Memo_Click()
On Error GoTo Err_Preview_Memo_Click

    Dim stDocName As String

    stDocName = "R_Memo_Print_2"
    DoCmd.OpenReport stDocName, acPreview

Exit_Preview_Memo_Click:
    Exit Sub

Err_Preview_Memo_Click:
    MsgBox Err.Description
    Resume Exit_Preview_Memo_Click
    
End Sub
Private Sub Print_Report_Click()
On Error GoTo Err_Print_Report_Click

    Dim stDocName As String

    stDocName = "R_Memo_Print_2"
    DoCmd.OpenReport stDocName, acNormal

Exit_Print_Report_Click:
    Exit Sub

Err_Print_Report_Click:
    MsgBox Err.Description
    Resume Exit_Print_Report_Click
    
End Sub
Private Sub E_Mail_Click()
On Error GoTo Err_E_Mail_Click

    Dim stDocName As String

    stDocName = "R_Memo_Print_2"
    DoCmd.SendObject acReport, stDocName

Exit_E_Mail_Click:
    Exit Sub

Err_E_Mail_Click:
    MsgBox Err.Description
    Resume Exit_E_Mail_Click
    
End Sub
Private Sub Command154_Click()
On Error GoTo Err_Command154_Click

    Dim stDocName As String

    stDocName = "R_Memo_Report"
    DoCmd.SendObject acReport, stDocName

Exit_Command154_Click:
    Exit Sub

Err_Command154_Click:
    MsgBox Err.Description
    Resume Exit_Command154_Click
    
End Sub
Private Sub Command155_Click()
On Error GoTo Err_Command155_Click

    Dim stDocName As String

    stDocName = "R_Memo_Report"
    DoCmd.OpenReport stDocName, acPreview

Exit_Command155_Click:
    Exit Sub

Err_Command155_Click:
    MsgBox Err.Description
    Resume Exit_Command155_Click
    
End Sub
Private Sub Command156_Click()
On Error GoTo Err_Command156_Click

    Dim stDocName As String

    stDocName = "R_Memo_print"
    DoCmd.OpenReport stDocName, acNormal

Exit_Command156_Click:
    Exit Sub

Err_Command156_Click:
    MsgBox Err.Description
    Resume Exit_Command156_Click
    
End Sub
Private Sub Command157_Click()
On Error GoTo Err_Command157_Click

    Dim stDocName As String

    stDocName = "R_Memo_print"
    DoCmd.OutputTo acReport, stDocName

Exit_Command157_Click:
    Exit Sub

Err_Command157_Click:
    MsgBox Err.Description
    Resume Exit_Command157_Click
    
End Sub
Private Sub Command158_Click()
On Error GoTo Err_Command158_Click

    Dim stDocName As String

    stDocName = "Q_Memo_Report"
    DoCmd.OpenQuery stDocName, acNormal, acEdit

Exit_Command158_Click:
    Exit Sub

Err_Command158_Click:
    MsgBox Err.Description
    Resume Exit_Command158_Click
    
End Sub
Private Sub Command159_Click()
On Error GoTo Err_Command159_Click

    Dim stDocName As String

    stDocName = "R_Memo_Print"
    DoCmd.SendObject acReport, stDocName

Exit_Command159_Click:
    Exit Sub

Err_Command159_Click:
    MsgBox Err.Description
    Resume Exit_Command159_Click
    
End Sub
Private Sub Command162_Click()
On Error GoTo Err_Command162_Click

    Dim stDocName As String

    stDocName = "R_Memo_Report"
    DoCmd.OpenReport stDocName, acPreview

Exit_Command162_Click:
    Exit Sub

Err_Command162_Click:
    MsgBox Err.Description
    Resume Exit_Command162_Click
    
End Sub
Private Sub Command163_Click()
On Error GoTo Err_Command163_Click


    DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

Exit_Command163_Click:
    Exit Sub

Err_Command163_Click:
    MsgBox Err.Description
    Resume Exit_Command163_Click
    
End Sub
Private Sub Q___R_Click()
On Error GoTo Err_Q___R_Click

    Dim stDocName As String
    Dim stLinkCriteria As String

    stDocName = "Q/R"
    DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Q___R_Click:
    Exit Sub

Err_Q___R_Click:
    MsgBox Err.Description
    Resume Exit_Q___R_Click
    
End Sub
Private Sub Command174_Click()
On Error GoTo Err_Command174_Click


    DoCmd.GoToRecord , , acFirst

Exit_Command174_Click:
    Exit Sub

Err_Command174_Click:
    MsgBox Err.Description
    Resume Exit_Command174_Click
    
End Sub

Private Sub Template_for_Tables_and_Arabic_Click()

Dim x As Integer
    Dim AppName As String
     AppName = "C:\Program Files\Microsoft Office\Office10\WINWORD.EXE" & " " & [FLIELOCATION]
     x = Shell(AppName, 1)
 
End Sub

Private Sub Refresh_Click()
On Error GoTo Err_Refresh_Click


    DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

Exit_Refresh_Click:
    Exit Sub

Err_Refresh_Click:
    MsgBox Err.Description
    Resume Exit_Refresh_Click
    
End Sub
Private Sub E_mail_To_Click()
On Error GoTo Err_E_mail_To_Click

    Dim stDocName As String

    stDocName = "R_Memo_Print"
    DoCmd.SendObject acReport, stDocName

Exit_E_mail_To_Click:
    Exit Sub

Err_E_mail_To_Click:
    MsgBox Err.Description
    Resume Exit_E_mail_To_Click
    
End Sub

Function Update_Status()
    On Error Resume Next
    If In_Date_Recieved And In_Date_Recieved <= Now Then
        Check_Status_1
        If Out_Date_Forwarded1 And Out_Date_Forwarded1 <= Now Then
            Check_Status_2
            If Out_Date_Forwarded2 And Out_Date_Forwarded2 <= Now Then
                Check_Status_3
            End If
        End If
    End If
End Function

Function Check_Status_1()
    On Error Resume Next
    Dim SubNo As Integer
    
    If Out_Date_Forwarded1 And Out_Date_Forwarded1 <= Now Then
        SubNo = Out_Date_Forwarded1 - In_Date_Recieved
        In_Period3 = SubNo
        Select Case SubNo
            Case Is <= 1
                In_Status3.BackColor = 32768
            Case Is <= 2
                In_Status3.BackColor = 33023
            Case Is <= 3
                In_Status3.BackColor = 255
            Case Is >= 3
                In_Status3.BackColor = 0
        End Select
    Else
        SubNo = Now - In_Date_Recieved
        In_Period3 = SubNo
        Select Case SubNo
            Case Is <= 1
                In_Status3.BackColor = 32768
            Case Is <= 2
                In_Status3.BackColor = 33023
            Case Is <= 3
                In_Status3.BackColor = 255
            Case Is >= 3
                In_Status3.BackColor = 0
        End Select
    End If
    
End Function

Function Check_Status_2()
    On Error Resume Next
    Dim SubNo As Integer
    
    If Out_Date_Forwarded2 And Out_Date_Forwarded2 <= Now Then
        SubNo = Out_Date_Forwarded2 - Out_Date_Forwarded1
        Out_Period1_1 = SubNo
        Select Case SubNo
            Case Is <= 1
                Out_Status1_1.BackColor = 32768
            Case Is <= 2
                Out_Status1_1.BackColor = 33023
            Case Is <= 3
                Out_Status1_1.BackColor = 255
            Case Is >= 3
                Out_Status1_1.BackColor = 0
        End Select
    Else
        SubNo = Now - Out_Date_Forwarded1
        Out_Period1_1 = SubNo
        Select Case SubNo
            Case Is <= 1
                Out_Status1_1.BackColor = 32768
            Case Is <= 2
                Out_Status1_1.BackColor = 33023
            Case Is <= 3
                Out_Status1_1.BackColor = 255
            Case Is >= 3
                Out_Status1_1.BackColor = 0
        End Select
    End If
    
End Function

Function Check_Status_3()
    On Error Resume Next
    Dim SubNo As Integer
    
    If Completion_Date And Completion_Date <= Now Then
        SubNo = Completion_Date - Out_Date_Forwarded2
        Out_Period2 = SubNo
        Select Case SubNo
            Case Is <= 3
                Out_Status2.BackColor = 32768
            Case Is <= 7
                Out_Status2.BackColor = 33023
            Case Is <= 15
                Out_Status2.BackColor = 255
            Case Is > 15
                Out_Status2.BackColor = 0
        End Select
    Else
        SubNo = Now - Out_Date_Forwarded2
        Out_Period2 = SubNo
        Select Case SubNo
            Case Is <= 3
                Out_Status2.BackColor = 32768
            Case Is <= 7
                Out_Status2.BackColor = 33023
            Case Is <= 15
                Out_Status2.BackColor = 255
            Case Is > 15
                Out_Status2.BackColor = 0
        End Select
    End If
    
End Function

Function NewRef()
    On Error Resume Next
    Dim Ref_No As Integer
    Dim M_No As Integer
    
    Open Application.CurrentProject.Path & "\month.txt" For Input As #1
    Input #1, M_No
    Close #1
    
    Open Application.CurrentProject.Path & "\ref.txt" For Input As #1
    Input #1, Ref_No
    Close #1
    
    If M_No = Month(Now) Then
        Ref_No = Ref_No + 1
    Else
        Ref_No = 1
    End If
    
    Open Application.CurrentProject.Path & "\month.txt" For Output As #1
    Write #1, Month(Now)
    Close #1
    
    Open Application.CurrentProject.Path & "\ref.txt" For Output As #1
    Write #1, Ref_No
    Close #1
    NewRef = "mas-opphc/" & Ref_No & "/" & Month(Now) & "/" & Year(Now)
    
End Function
