Attribute VB_Name = "ModFunc"
Option Explicit
    Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
    Private Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

Option Compare Text

Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

#If Win32 Then
    Public Const CB_FINDSTRING = &H14C
    Public Const CB_FINDSTRINGEXACT = &H158
    Public Const LB_FINDSTRING = &H18F
    Public Const LB_FINDSTRINGEXACT = &H1A2
#Else
    Public Const WM_USER = &H400
    Public Const CB_FINDSTRING = WM_USER + 12
    Public Const CB_FINDSTRINGEXACT = WM_USER + 24
    Public Const LB_FINDSTRING = WM_USER + 16
    Public Const LB_FINDSTRINGEXACT = WM_USER + 35
#End If

   Dim sLastServer
   Dim sServerUserID
   Dim sServerPassword

Public Function FindFirstMatch(ByVal ctlSearch As Control, ByVal SearchString As String, ByVal FirstRow As Integer, ByVal Exact As Boolean) As Integer

#If Win32 Then
    Dim Index As Long
#Else
    Dim Index As Integer
#End If

On Error Resume Next
If TypeOf ctlSearch Is ComboBox Then
    If Exact Then
        Index = SendMessage(ctlSearch.hWnd, CB_FINDSTRINGEXACT, FirstRow, ByVal SearchString)
    Else
        Index = SendMessage(ctlSearch.hWnd, CB_FINDSTRING, FirstRow, ByVal SearchString)
    End If
ElseIf TypeOf ctlSearch Is ListBox Then
    If Exact Then
        Index = SendMessage(ctlSearch.hWnd, LB_FINDSTRINGEXACT, FirstRow, ByVal SearchString)
    Else
        Index = SendMessage(ctlSearch.hWnd, LB_FINDSTRING, FirstRow, ByVal SearchString)
    End If
End If

FindFirstMatch = Index

End Function

Function Null2Space(vType As Variant) As String
    If IsNull(vType) Then
        vType = " "
    Else
        vType = CStr(vType)
    End If
    Null2Space = vType
End Function
Public Function PadRight(Source As String, iNum As Integer)
    Dim iLen As Integer, iSpaces As Integer
    
    iLen = Len(Trim$(Source))
    If iLen < iNum Then
        iSpaces = iNum - iLen
        PadRight = Trim$(Source) & Space(iSpaces)
    End If
End Function

Public Function PadLeftZero(Source As String)
    Dim strZero As String
    
    strZero = "00000"
    PadLeftZero = Mid(strZero, 1, Len(strZero) - Len(Trim(Source))) & Trim$(Source)
End Function

Public Function Upper(nKeyAscii)
    Upper = Asc(UCase(Chr(nKeyAscii)))
End Function
Public Function CalcAge(datEmpDateOfBirth As Variant) As Integer
    If Not IsNull(datEmpDateOfBirth) Then
       CalcAge = Int(DateDiff("y", datEmpDateOfBirth, Date) / 365.25)
    End If
End Function

Sub FadeForm(frm As Form, Red%, Green%, Blue%)
    
    Dim SaveScale%, SaveStyle%, SaveRedraw%
    Dim i&, j&, x&, y&, pixels%
    
    'Save current settings.
    SaveScale = frm.ScaleMode
    SaveStyle = frm.DrawStyle
    SaveRedraw = frm.AutoRedraw
    
    'Paint screen.
    frm.ScaleMode = 3
    pixels = Screen.Height / Screen.TwipsPerPixelY
    x = pixels / 64# + 0.5
    frm.DrawStyle = 5
    frm.AutoRedraw = True
    For j = 0 To pixels Step x
        y = 240 - 245 * j \ pixels
        'can tweak this to preference.
        If y < 0 Then y = 0
        'just in case
        frm.Line (-2, j - 2)-(Screen.Width + 2, j + _
            x + 3), RGB(-Red * y, -Green * y, -Blue * y), BF
    Next j
    
    'Reset to previous settings.
    frm.ScaleMode = SaveScale
    frm.DrawStyle = SaveStyle
    frm.AutoRedraw = SaveRedraw
    
End Sub
'This function is used to filter input validation
'Keyascii=Valitext(keyascii,"1234567890.", true )
'Put this in keypress event
Function ValiText(KeyIn As Integer, _
    ValidateString As String, _
    Editable As Boolean) As Integer

    Dim ValidateList As String
    Dim KeyOut As Integer
    
    If Editable = True Then
        ValidateList = UCase(ValidateString) & Chr(8)
    Else
        ValidateList = UCase(ValidateString)
    End If
    
    If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) > 0 Then
        KeyOut = KeyIn
    Else
        KeyOut = 0
        Beep
    End If
    
    ValiText = KeyOut
End Function

Public Sub OpenMainReport(ByVal strReportFileName As String, ParamArray strParameters())
   On Error Resume Next

   Dim crxParameterField As CRAXDRT.ParameterFieldDefinition
   Dim intCtr As Integer
   Dim intTotalParam As Integer
   Dim crxtable As CRAXDRT.DatabaseTable
   Dim crxApplication As New CRAXDRT.Application
   
   ''''' Get the Last Server Name entered. '''''
   sLastServer = GetSetting(App.Title, "Connection", "Server")
   sServerUserID = GetSetting(App.Title, "Connection", "UserID")
   sServerPassword = GetSetting(App.Title, "Connection", "Password")
   
   intTotalParam = UBound(strParameters)
   Set Report = crxApplication.OpenReport(strReportFileName, 1)
   For Each crxtable In Report.Database.Tables
        crxtable.Location = "College" + Mid(crxtable.Location, InStr(1, crxtable.Location, "."))
        crxtable.SetLogOnInfo sLastServer, "College", sServerUserID, sServerPassword
   Next

   If intTotalParam >= 0 Then
      For Each crxParameterField In Report.ParameterFields
         If intTotalParam >= intCtr Then
            crxParameterField.AddCurrentValue strParameters(intCtr)
         Else
            Exit For
         End If
         intCtr = intCtr + 1
      Next
   End If
   Set crxParameterField = Nothing
   Set crxtable = Nothing
   Set crxApplication = Nothing

End Sub

Public Sub OpenSubReport(ByVal strSubReport As String, ParamArray strParameters())
   On Error Resume Next

   Dim crxParameterField As CRAXDRT.ParameterFieldDefinition
   Dim intCtr As Integer
   Dim intTotalParam As Integer
   Dim crxtable As CRAXDRT.DatabaseTable
   Dim crxSubreport As CRAXDRT.Report

   ''''' Get the Last Server Name entered. '''''
   sLastServer = GetSetting(App.Title, "Connection", "Server")
   sServerUserID = GetSetting(App.Title, "Connection", "UserID")
   sServerPassword = GetSetting(App.Title, "Connection", "Password")

   intTotalParam = UBound(strParameters)
   Set crxSubreport = Report.OpenSubReport(strSubReport)
   For Each crxtable In crxSubreport.Database.Tables
      crxtable.Location = "College" + Mid(crxtable.Location, InStr(1, crxtable.Location, "."))
      crxtable.SetLogOnInfo sLastServer, "College", sServerUserID, sServerPassword
   Next

   If intTotalParam >= 0 Then
      For Each crxParameterField In crxSubreport.ParameterFields
         If intTotalParam >= intCtr Then
            crxParameterField.AddCurrentValue strParameters(intCtr)
         Else
            Exit For
         End If
         intCtr = intCtr + 1
      Next
   End If
   Set crxParameterField = Nothing
   Set crxtable = Nothing
   Set crxSubreport = Nothing
End Sub

Public Sub ShowReportViewer(Optional blnShowGroupTree As Boolean = False, Optional strCaption As String = "", Optional blnDirectToPrinter As Boolean = False)
    Dim frmRView As New frmReportView
    
    With frmRView
        If blnDirectToPrinter = True Then
            Report.DisplayProgressDialog = False
            Report.PrintOut False
            Set Report = Nothing
        Else
            .ShowGroupTree = blnShowGroupTree
            .DirectPrint = blnDirectToPrinter
            .Caption = strCaption
            .Show vbModal
        End If
    End With
End Sub

Public Sub ShowReportViewerNotModal(Optional blnShowGroupTree As Boolean = False, Optional strCaption As String = "", Optional blnDirectToPrinter As Boolean = False)

       Dim frmRView As New frmReportView
       With frmRView
          .ShowGroupTree = blnShowGroupTree
          .Caption = strCaption
          .DirectPrint = blnDirectToPrinter
          .Show
       End With
  
End Sub


Public Sub SetUserSetting()
    Dim rstRecordset As New ADODB.Recordset

    rstRecordset.Open "SELECT * FROM Password..tbPasswordMain WHERE EmployeeID = '" & _
                      Trim(strUserID) & "'", con, adOpenDynamic, adLockReadOnly
    If Not rstRecordset.EOF Then
        strMenu1 = rstRecordset!Menu1 & ""
        strMenu2 = rstRecordset!Menu2 & ""
    End If
    rstRecordset.Close
    
    With frmMainRegister
        'Registration Menu.
        .mnuAdmission.Enabled = IIf(Mid(Trim(strMenu1), 1, 1) = "1", True, False)
        .mnuRegister.Enabled = IIf(Mid(Trim(strMenu1), 2, 1) = "1", True, False)
        .mnuAddDrop.Enabled = IIf(Mid(Trim(strMenu1), 3, 1) = "1", True, False)
        .mnuWithdraw.Enabled = IIf(Mid(Trim(strMenu1), 4, 1) = "1", True, False)
        .mnuEnterGrades.Enabled = IIf(Mid(Trim(strMenu1), 5, 1) = "1", True, False)
        .mnuReAssess.Enabled = IIf(Mid(Trim(strMenu1), 6, 1) = "1", True, False)
        .mnuPlans.Enabled = IIf(Mid(Trim(strMenu1), 7, 1) = "1", True, False)
        .mnuSchedules.Enabled = IIf(Mid(Trim(strMenu1), 8, 1) = "1", True, False)
        .mnuSchedulesReport.Enabled = IIf(Mid(Trim(strMenu1), 9, 1) = "1", True, False)
        .mnuDeanEntry.Enabled = IIf(Mid(Trim(strMenu1), 10, 1) = "1", True, False)
        .mnuTransferee.Enabled = IIf(Mid(Trim(strMenu1), 11, 1) = "1", True, False)
        .mnuCrossEnrolled.Enabled = IIf(Mid(Trim(strMenu1), 12, 1) = "1", True, False)
        .mnuOldGrades.Enabled = IIf(Mid(Trim(strMenu1), 13, 1) = "1", True, False)
        .mnuForeignCredited.Enabled = IIf(Mid(Trim(strMenu1), 14, 1) = "1", True, False)
        .mnuPersonal.Enabled = IIf(Mid(Trim(strMenu1), 15, 1) = "1", True, False)
        .mnuEvaluation.Enabled = IIf(Mid(Trim(strMenu1), 16, 1) = "1", True, False)
        .lblMenu1(0).Enabled = IIf(Mid(Trim(strMenu1), 1, 1) = "1", True, False)
        .lblMenu1(1).Enabled = IIf(Mid(Trim(strMenu1), 2, 1) = "1", True, False)
        .lblMenu1(2).Enabled = IIf(Mid(Trim(strMenu1), 3, 1) = "1", True, False)
        .lblMenu1(3).Enabled = IIf(Mid(Trim(strMenu1), 4, 1) = "1", True, False)
        .lblMenu1(4).Enabled = IIf(Mid(Trim(strMenu1), 5, 1) = "1", True, False)
        .lblMenu1(5).Enabled = IIf(Mid(Trim(strMenu1), 6, 1) = "1", True, False)
        .lblMenu1(6).Enabled = IIf(Mid(Trim(strMenu1), 7, 1) = "1", True, False)
        .lblMenu1(7).Enabled = IIf(Mid(Trim(strMenu1), 8, 1) = "1", True, False)
        .lblMenu1(8).Enabled = IIf(Mid(Trim(strMenu1), 9, 1) = "1", True, False)
        .lblMenu1(9).Enabled = IIf(Mid(Trim(strMenu1), 10, 1) = "1", True, False)
        .lblMenu1(10).Enabled = IIf(Mid(Trim(strMenu1), 11, 1) = "1", True, False)
        .lblMenu1(11).Enabled = IIf(Mid(Trim(strMenu1), 12, 1) = "1", True, False)
        .lblMenu1(12).Enabled = IIf(Mid(Trim(strMenu1), 13, 1) = "1", True, False)
        .lblMenu1(13).Enabled = IIf(Mid(Trim(strMenu1), 14, 1) = "1", True, False)
        .lblMenu2(0).Enabled = IIf(Mid(Trim(strMenu1), 15, 1) = "1", True, False)
        .lblMenu2(1).Enabled = IIf(Mid(Trim(strMenu1), 16, 1) = "1", True, False)
        'Reports Menu.
        'Old Menu Options.
        .mnuListEnroll.Enabled = IIf(Mid(Trim(strMenu2), 1, 1) = "1", True, False)
        .mnuSortedList.Enabled = IIf(Mid(Trim(strMenu2), 2, 1) = "1", True, False)
        .mnuListROTC.Enabled = IIf(Mid(Trim(strMenu2), 3, 1) = "1", True, False)
        .mnuListStudPlan.Enabled = IIf(Mid(Trim(strMenu2), 4, 1) = "1", True, False)
        .mnuListStudSubject.Enabled = IIf(Mid(Trim(strMenu2), 5, 1) = "1", True, False)
        .mnuListForeign.Enabled = IIf(Mid(Trim(strMenu2), 6, 1) = "1", True, False)
        .mnuListCourses.Enabled = IIf(Mid(Trim(strMenu2), 7, 1) = "1", True, False)
        .mnuListStudOffering.Enabled = IIf(Mid(Trim(strMenu2), 8, 1) = "1", True, False)
        .mnuListStudCountry.Enabled = IIf(Mid(Trim(strMenu2), 9, 1) = "1", True, False)
        .mnuRepEnroll.Enabled = IIf(Mid(Trim(strMenu2), 10, 1) = "1", True, False)
        .mnuDistribution.Enabled = IIf(Mid(Trim(strMenu2), 11, 1) = "1", True, False)
        .mnuScholastic.Enabled = IIf(Mid(Trim(strMenu2), 12, 1) = "1", True, False)
        .mnuSummEnroll.Enabled = IIf(Mid(Trim(strMenu2), 13, 1) = "1", True, False)
        .mnuSummCourse.Enabled = IIf(Mid(Trim(strMenu2), 14, 1) = "1", True, False)
        .mnuFinalGrades.Enabled = IIf(Mid(Trim(strMenu2), 15, 1) = "1", True, False)
        .mnuTranscript.Enabled = IIf(Mid(Trim(strMenu2), 16, 1) = "1", True, False)
        .mnuCertPassed.Enabled = IIf(Mid(Trim(strMenu2), 17, 1) = "1", True, False)
        .mnuAssessRePrint.Enabled = IIf(Mid(Trim(strMenu2), 18, 1) = "1", True, False)
        .mnuSubjectLoad.Enabled = IIf(Mid(Trim(strMenu2), 19, 1) = "1", True, False)
        .mnuPermit.Enabled = IIf(Mid(Trim(strMenu2), 20, 1) = "1", True, False)
        .mnuCurriculum.Enabled = IIf(Mid(Trim(strMenu2), 21, 1) = "1", True, False)
        .mnuForeignStudents.Enabled = IIf(Mid(Trim(strMenu2), 22, 1) = "1", True, False)
        .mnuPresidentList.Enabled = IIf(Mid(Trim(strMenu2), 23, 1) = "1", True, False)
        .mnuDeanList.Enabled = IIf(Mid(Trim(strMenu2), 24, 1) = "1", True, False)
        .mnuListStudOffer.Enabled = IIf(Mid(Trim(strMenu2), 25, 1) = "1", True, False)
        .mnuRegCertificate.Enabled = IIf(Mid(Trim(strMenu2), 26, 1) = "1", True, False)
        
        'New Menu Options.
'        .mnuEnrollmentList.Enabled = IIf(Mid(Trim(strMenu2), 1, 1) = "1", True, False)
'        .mnuScheduleInfoList.Enabled = IIf(Mid(Trim(strMenu2), 2, 1) = "1", True, False)
'        .mnuSectionBlock.Enabled = IIf(Mid(Trim(strMenu2), 3, 1) = "1", True, False)
'        .mnuChedForm.Enabled = IIf(Mid(Trim(strMenu2), 4, 1) = "1", True, False)
'        .mnuReportCard.Enabled = IIf(Mid(Trim(strMenu2), 5, 1) = "1", True, False)
'        .mnuStudentInfo.Enabled = IIf(Mid(Trim(strMenu2), 6, 1) = "1", True, False)
'        .mnuListStudOffer.Enabled = IIf(Mid(Trim(strMenu2), 7, 1) = "1", True, False)
'        .mnuGradingSheet.Enabled = IIf(Mid(Trim(strMenu2), 8, 1) = "1", True, False)
'        .mnuRegCertificate.Enabled = IIf(Mid(Trim(strMenu2), 9, 1) = "1", True, False)
'        .mnuListWithdrawn.Enabled = IIf(Mid(Trim(strMenu2), 10, 1) = "1", True, False)
'        .mnuStudentList.Enabled = IIf(Mid(Trim(strMenu2), 11, 1) = "1", True, False)
'        .mnuInstructorsLoad.Enabled = IIf(Mid(Trim(strMenu2), 12, 1) = "1", True, False)
'        .mnuIncomplete.Enabled = IIf(Mid(Trim(strMenu2), 13, 1) = "1", True, False)
'        .mnuWGrades.Enabled = IIf(Mid(Trim(strMenu2), 14, 1) = "1", True, False)
'        .mnuListEnroll.Enabled = IIf(Mid(Trim(strMenu2), 15, 1) = "1", True, False)
'        .mnuListROTC.Enabled = IIf(Mid(Trim(strMenu2), 16, 1) = "1", True, False)
'        .mnuNSTPGraduates.Enabled = IIf(Mid(Trim(strMenu2), 17, 1) = "1", True, False)
'        .mnuListGraduates.Enabled = IIf(Mid(Trim(strMenu2), 18, 1) = "1", True, False)
'        .mnuDroppedFailures.Enabled = IIf(Mid(Trim(strMenu2), 19, 1) = "1", True, False)
'        .mnuListStudPlan.Enabled = IIf(Mid(Trim(strMenu2), 20, 1) = "1", True, False)
'        .mnuListStudSubject.Enabled = IIf(Mid(Trim(strMenu2), 21, 1) = "1", True, False)
'        .mnuListCourses.Enabled = IIf(Mid(Trim(strMenu2), 22, 1) = "1", True, False)
'        .mnuListStudCountry.Enabled = IIf(Mid(Trim(strMenu2), 23, 1) = "1", True, False)
'        .mnuRepEnroll.Enabled = IIf(Mid(Trim(strMenu2), 24, 1) = "1", True, False)
'        .mnuDistribution.Enabled = IIf(Mid(Trim(strMenu2), 25, 1) = "1", True, False)
'        .mnuScholastic.Enabled = IIf(Mid(Trim(strMenu2), 26, 1) = "1", True, False)
'        .mnuSummEnroll.Enabled = IIf(Mid(Trim(strMenu2), 27, 1) = "1", True, False)
'        .mnuSummCourse.Enabled = IIf(Mid(Trim(strMenu2), 28, 1) = "1", True, False)
'        .mnuTranscript.Enabled = IIf(Mid(Trim(strMenu2), 29, 1) = "1", True, False)
'        .mnuCurriculum.Enabled = IIf(Mid(Trim(strMenu2), 30, 1) = "1", True, False)
'        .mnuForeignStudents.Enabled = IIf(Mid(Trim(strMenu2), 31, 1) = "1", True, False)
'        .mnuAdmissionReports.Enabled = IIf(Mid(Trim(strMenu2), 32, 1) = "1", True, False)
'        .mnuListNewStudents.Enabled = IIf(Mid(Trim(strMenu2), 33, 1) = "1", True, False)
'        .mnuListTransferee.Enabled = IIf(Mid(Trim(strMenu2), 34, 1) = "1", True, False)
        
        .lblMenu3(0).Enabled = IIf(Mid(Trim(strMenu2), 1, 1) = "1", True, False)
        .lblMenu3(1).Enabled = IIf(Mid(Trim(strMenu2), 10, 1) = "1", True, False)
        .lblMenu3(2).Enabled = IIf(Mid(Trim(strMenu2), 12, 1) = "1", True, False)
        .lblMenu3(3).Enabled = IIf(Mid(Trim(strMenu2), 13, 1) = "1", True, False)
        .lblMenu3(4).Enabled = IIf(Mid(Trim(strMenu2), 14, 1) = "1", True, False)
    End With
    
End Sub

Public Function SavePictureToDB(oPictureControl As Object, adoRS As ADODB.Recordset, sFieldName As String) As Boolean
    Dim oPict As StdPicture
    Dim sDir As String, sTempFile As String
    Dim iFileNum As Integer
    Dim lFileLength As Long
    Dim abBytes() As Byte
    Dim iCtr As Integer
    
    On Error GoTo ErrHandler
    
    Set oPict = oPictureControl.Picture
    If oPict Is Nothing Then
        SavePictureToDB = False
        Exit Function
    End If

    'Save picture to temp file
    sTempFile = FileGetTempName
    SavePicture oPict, sTempFile
    
    'read file contents to byte array
    iFileNum = FreeFile
    Open sTempFile For Binary Access Read As #iFileNum
    lFileLength = LOF(iFileNum)
    ReDim abBytes(lFileLength)
    Get #iFileNum, , abBytes()
    'put byte array contents into db field
    adoRS.Fields(sFieldName).AppendChunk abBytes()
    Close #iFileNum
    
    'Don't return false if file can't be deleted
    On Error Resume Next
    Kill sTempFile
    SavePictureToDB = True
    Exit Function
    
ErrHandler:
    SavePictureToDB = False
    Debug.Print Err.Description
End Function

Public Function LoadPictureFromDB(oPictureControl As Object, adoRS As ADODB.Recordset, sFieldName As String) As Boolean
    Dim oPict As StdPicture
    Dim sDir As String
    Dim sTempFile As String
    Dim iFileNum As Integer
    Dim lFileLength As Long
    Dim abBytes() As Byte
    Dim iCtr As Integer
    
    On Error GoTo ErrHandler
    sTempFile = FileGetTempName
   
    iFileNum = FreeFile
    Open sTempFile For Binary As #iFileNum
    lFileLength = LenB(adoRS(sFieldName))
    
    abBytes = adoRS(sFieldName).GetChunk(lFileLength)
    Put #iFileNum, , abBytes()
    Close #iFileNum

    oPictureControl.Picture = LoadPicture(sTempFile)
    'Resize photo size.
    oPictureControl.ScaleMode = 3
    oPictureControl.AutoRedraw = True
    oPictureControl.PaintPicture oPictureControl.Picture, 0, 0, _
    oPictureControl.ScaleWidth, oPictureControl.ScaleHeight, 0, 0, _
    oPictureControl.Picture.Width / 26.46, oPictureControl.Picture.Height / 26.46
    
    Kill sTempFile
    LoadPictureFromDB = True
    Exit Function
    
ErrHandler:
    LoadPictureFromDB = False
    Debug.Print Err.Description
End Function

Function FileGetTempName(Optional sFilePrefix As String = "TMP") As String
    Dim sTemp As String * 260, lngLen As Long
    Static ssTempPath As String
    
    If LenB(ssTempPath) = 0 Then
        'Get the temporary path
        lngLen = GetTempPath(260, sTemp)
        'strip the rest of the buffer
        ssTempPath = Left$(sTemp, lngLen)
        If Right$(ssTempPath, 1) <> "\" Then
            ssTempPath = ssTempPath & "\"
        End If
    End If
    
    'Get a temporary filename
    lngLen = GetTempFileName(ssTempPath, sFilePrefix, 0, sTemp)
    'Remove all the unnecessary chr$(0)'s
    FileGetTempName = Left$(sTemp, InStr(1, sTemp, Chr$(0)) - 1)
End Function

Public Function UpdateLogs()

    Dim r As New ADODB.Recordset
    Dim strSQL As String
    Dim strUserID As String
    Dim strModuleName As String

    
    '--remove previous logs where month <> month(getdate) and year <> year(getdate) added by sensei
    con.Execute "delete from password..tbchangelog where month(DateModified) <> month(getdate()) and year(DateModified)  <>  year(getdate())"
    
    strUserID = frmMainRegister.lblUserName.Caption
    strModuleName = "College Registration"
    con.Execute "insert into Password..tbChangeLog Values ('" & UserID & "','" & Now & "','" & strActivities & "','" & strModuleName & "')"
    Exit Function

End Function