Home - GaryHostt/Training_repository GitHub Wiki

Welcome to the Training_repository wiki!

Features added to MS Access database

Auto backup of database

Function AutoRun() 'called thru macro AutoExec: RunCode AutoRun() Dim sFile As String, oForm As Form Set oForm = Form_frmBackup oForm.Visible = False End Function

Sub BackUp() 'Make the folder a Trusted Location

Dim sFile As String, oDB As DAO.Database 'set reference to MS Data Access objects library
'If DAO.dll does not load, then find ACEDAO.dll
'In program files or MS Office AC DB Engine object
'sFile = CurrentProject.Path & "\" & Format(Date, "m-d-yy") & ".accdb"
'above is using currentproject path, below uses specify project path

sFile = "C:\Users\account.temp\Desktop\Database backups" & "\" & Format(Date, "m-d-yy") & ".accdb"
If Dir(sFile) <> "" Then Kill sFile
Set oDB = DBEngine.Workspaces(0).CreateDatabase(sFile, dbLangGeneral)
oDB.Close

Dim oTD As TableDef
For Each oTD In CurrentDb.TableDefs
    If Left(oTD.Name, 4) <> "MSys" Then
    DoCmd.CopyObject sFile, , acTable, oTD.Name
    'OR: DoCmd.TransferDatabase acExport, "Microsoft Access" sFile, acTAble, oTD.Name
    End If
Next oTD

MsgBox "Backup of tables is stored in the specified folder" & vbCr & _
"under the file name " & Right(sFile, Len(sFile) - InStrRev(sFile, "\"))

End Sub

User level access Private Sub btnLogin_Click() Dim User As String Dim UserLevel As Integer Dim TempPass As String Dim ID As Integer Dim Username As String Dim TempID As String

If IsNull(Me.txtUsername) Then MsgBox "Please select UserName", vbInformation, "Username required" Me.txtUsername.SetFocus ElseIf IsNull(Me.txtPassword) Then MsgBox "Please enter Password", vbInformation, "Password required" Me.txtPassword.SetFocus Else If (IsNull(DLookup("UserLogin", "tblUser", "UserLogin = '" & Me.txtUsername.Value & "' And UserPassword = '" & Me.txtPassword.Value & "'"))) Then MsgBox "Invalid Username or Password!" Else TempID = Me.txtUsername.Value Username = DLookup("[UserName]", "tblUser", "[UserLogin] = '" & Me.txtUsername.Value & "'") UserLevel = DLookup("[UserType]", "tblUser", "[UserLogin] = '" & Me.txtUsername.Value & "'") TempPass = DLookup("[UserPassword]", "tblUser", "[UserLogin] = '" & Me.txtUsername.Value & "'") UserLogin = DLookup("[UserLogin]", "tblUser", "[UserLogin] = '" & Me.txtUsername.Value & "'") DoCmd.Close

'TempVars("UserName").Value = Me.txtUsername.Value

If (TempPass = "password") Then 'figure this out MsgBox "Please change Password", vbInformation, "New password required" DoCmd.OpenForm "frmUserinfo", , , "[UserLogin] = " & UserLogin Else 'open different form according to user level If UserLevel = 1 Then ' for admin DoCmd.OpenForm "frmMain_trainer" ElseIf UserLevel = 2 Then DoCmd.OpenForm "frmMain_supervisor" ElseIf UserLevel = 3 Then DoCmd.OpenForm "frmMain_trainer" ElseIf UserLevel = 4 Then DoCmd.OpenForm "frmMain_Dbadministrator"

End If

End If End If End If End Sub

Buttons on main menu to show the ribbon & navigation pane & delete all records Private Sub cmdDelete_Click() MSG1 = MsgBox("Would you like to delete all overtime records?", vbYesNo)
If MSG1 = vbYes Then CurrentDb.Execute "Delete * From tblShiftOT;" End If End Sub

Private Sub Command136_Click() DoCmd.ShowToolbar "Ribbon", acToolbarYes End Sub

Private Sub Command140_Click() Call DoCmd.SelectObject(acTable, , True) End Sub

SQL code to develop cross tab view of training

Training: SELECT tblFiltrationEmployeeQualifications.[Multiple Training].Value AS Qualification, tblFiltrationEmployeeQualifications.[Multiple Employees].Value AS [Trained Employee Number], tblFiltrationEmployeeQualifications.[Qualification Level], tblFiltrationEmployeeQualifications.[Date trained], tblFiltrationEmployeeQualifications.ID_Training AS [Employee Number of Trainer], tblFiltrationEmployeeQualifications.[Version Trained], DateDiff("d",[Date Trained],Date()) AS [Days since trained], tblFiltrationEmployeeQualifications.Hours_to_train FROM tblFiltrationEmployeeQualifications WHERE (((tblFiltrationEmployeeQualifications.[Multiple Training].Value) Is Not Null) AND ((tblFiltrationEmployeeQualifications.[Multiple Employees].Value) Is Not Null) AND ((DateDiff("d",[Date Trained],Date()))<70));

Crosstab view: TRANSFORM Last(qryFiltCustomTrainingGroup.[Qualification Level]) AS [LastOfQualification Level] SELECT qryFiltCustomTrainingGroup.[Trained Employee Number] AS [Employee Number], qryAllFiltrationEmployees.[First Name], qryAllFiltrationEmployees.[Last Name] FROM qryFiltCustomTrainingGroup, qryAllFiltrationEmployees WHERE (((qryAllFiltrationEmployees.Employee_ID)=[qryFiltCustomTrainingGroup].[Trained Employee Number] And (qryAllFiltrationEmployees.Employee_ID)=[qryFiltCustomTrainingGroup].[Trained Employee Number])) GROUP BY qryFiltCustomTrainingGroup.[Trained Employee Number], qryAllFiltrationEmployees.[First Name], qryAllFiltrationEmployees.[Last Name] PIVOT ColumnName([qryFiltCustomTrainingGroup].[Qualification]);

Modules for the above and column names for cross tab view:

Option Compare Database

Function AutoRun() 'called thru macro AutoExec: RunCode AutoRun() Dim sFile As String, oForm As Form Set oForm = Form_frmBackup oForm.Visible = False End Function

Sub BackUp() 'Make the folder a Trusted Location

Dim sFile As String, oDB As DAO.Database 'set reference to MS Data Access objects library
'If DAO.dll does not load, then find ACEDAO.dll
'In program files or MS Office AC DB Engine object
'sFile = CurrentProject.Path & "\" & Format(Date, "m-d-yy") & ".accdb"
'above is using currentproject path, below uses specify project path

sFile = "C:\Users\account.temp\Desktop\Database backups" & "\" & Format(Date, "m-d-yy") & ".accdb"
If Dir(sFile) <> "" Then Kill sFile
Set oDB = DBEngine.Workspaces(0).CreateDatabase(sFile, dbLangGeneral)
oDB.Close

Dim oTD As TableDef
For Each oTD In CurrentDb.TableDefs
    If Left(oTD.Name, 4) <> "MSys" Then
    DoCmd.CopyObject sFile, , acTable, oTD.Name
    'OR: DoCmd.TransferDatabase acExport, "Microsoft Access" sFile, acTAble, oTD.Name
    End If
Next oTD

MsgBox "Backup of tables is stored in the specified folder" & vbCr & _
"under the file name " & Right(sFile, Len(sFile) - InStrRev(sFile, "\"))

End Sub

'Public Sub Logging(Activity As String) 'CurrentDb.Execute "INSERT INTO tblActivityLog (Username, Activity) Values('" & TempVars("UserName").Value & "', '" & Activity & "')"

'Call TempVars("UserName").Value

'End Sub Function ColumnName(Qualification As String) As String Select Case Qualification 'filtration training spreadsheet Case "2" ColumnName = "502:Ultrasonic" Case "3" ColumnName = "502:Assembly" Case "4" ColumnName = "502:Oven" Case "5" ColumnName = "502:Printer" Case "6" ColumnName = "502:Pleater" Case "7" ColumnName = "502:Bubble Test" Case "8" ColumnName = "503:Ultrasonic" Case "9" ColumnName = "503:Assembly" Case "10" ColumnName = "503:Caps" Case "11" ColumnName = "503:Oven" Case "12" ColumnName = "601:Headers" Case "13" ColumnName = "601:Pump Assembly" Case "14" ColumnName = "601:Bowls" Case "15" ColumnName = "601:Header/Bowl" Case "16" ColumnName = "601:Leak Test" Case "17" ColumnName = "601:Brackets" Case "18" ColumnName = "601:Impact Tape" Case "19" ColumnName = "601:Foam" Case "20" ColumnName = "601:FLOATER" Case "21" ColumnName = "601W:Bowl Warmer" Case "22" ColumnName = "601W:Welder" Case "23" ColumnName = "601W:Pins" Case "24" ColumnName = "601W:Fumex Filter Replacement" Case "25" ColumnName = "602:Welder" Case "26" ColumnName = "602:Leak Test" Case "27" ColumnName = "602:Burst Test" Case "28" ColumnName = "602B:Bracket Press" Case "29" ColumnName = "604:St.1" Case "30" ColumnName = "604:St.2" Case "31" ColumnName = "604:St.3" Case "32" ColumnName = "604:GP-12" Case "33" ColumnName = "803:101" Case "34" ColumnName = "803:102" Case "35" ColumnName = "803:103" Case "36" ColumnName = "803:105" Case "37" ColumnName = "803:110" Case "38" ColumnName = "803:115" Case "39" ColumnName = "803:120" Case "40" ColumnName = "803:125" Case "41" ColumnName = "803:130" Case "42" ColumnName = "803:135" Case "43" ColumnName = "803:140" Case "44" ColumnName = "803:145" Case "45" ColumnName = "803:146" Case "46" ColumnName = "803:150" Case "47" ColumnName = "803:155" Case "48" ColumnName = "803:160" Case "49" ColumnName = "803:Changeover" Case "50" ColumnName = "803:First Piece Inspection" Case "51" ColumnName = "803:Bubble/Burst Test" Case "52" ColumnName = "901:Changeover" Case "53" ColumnName = "901:Assembly" Case "54" ColumnName = "901:Packaging" Case "55" ColumnName = "902/903/904:St.1" Case "56" ColumnName = "902/903/904:St.2" Case "57" ColumnName = "Filter Train:Filter Train" Case "58" ColumnName = "Filter Train:Red Cap" Case "59" ColumnName = "Filter Train:Stacker" Case "60" ColumnName = "501:Ultrasonic" Case "61" ColumnName = "501:Clipper" Case "62" ColumnName = "501:Assembly" Case "63" ColumnName = "501:Caps" Case "64" ColumnName = "501:PLEATER" Case "65" ColumnName = "501:Printer" Case "66" ColumnName = "501:Bubble Test" Case "67" ColumnName = "501:Oven" Case "68" ColumnName = "90x:Stacker" Case Else ColumnName = "Area:Qualfication"

End Select End Function

Function ColumnName2(Qualification As String) As String Select Case Qualification 'manifold training spreadsheet Case "11" ColumnName2 = "551,552:235 Bodies" Case "12" ColumnName2 = "554,555:Filter Covers" Case "13" ColumnName2 = "554,555:Plunger Tubes" Case "14" ColumnName2 = "554,555:Stirups" Case "15" ColumnName2 = "553:263 Bodies" Case "16" ColumnName2 = "556:Ford Main Housing" Case "17" ColumnName2 = "558: Leak and Assembly" Case "18" ColumnName2 = "557:Ford Bowl" Case "19" ColumnName2 = "558:Ford Box Filter Panel" Case "20" ColumnName2 = "561-565:Duramax IM" Case "21" ColumnName2 = "561-565:GM LFE Mold" Case "22" ColumnName2 = "561-565:GM Upper/Lower Shell" Case "23" ColumnName2 = "561-565:GM NVH Cover" Case "24" ColumnName2 = "566,567:566/567 Denso Upper/Middle/Lower" Case "25" ColumnName2 = "568:Subaru Upper/Lower Shell IM" Case "26" ColumnName2 = "561,562:250" Case "27" ColumnName2 = "561,562:300" Case "28" ColumnName2 = "561,562:350" Case "29" ColumnName2 = "561,562:400" Case "30" ColumnName2 = "561,562:450" Case "31" ColumnName2 = "561,562:500" Case "32" ColumnName2 = "561,562:550" Case "33" ColumnName2 = "561,562:600" Case "34" ColumnName2 = "561,562:650" Case "35" ColumnName2 = "561,562:700" Case "36" ColumnName2 = "561,562:GP-12" Case "37" ColumnName2 = "566,567:100" Case "38" ColumnName2 = "566,567:150" Case "39" ColumnName2 = "566,567:200" Case "40" ColumnName2 = "566,567:250" Case "41" ColumnName2 = "566,567:300" Case "42" ColumnName2 = "566,567:350" Case "43" ColumnName2 = "566,567:400" Case "44" ColumnName2 = "566,567:450" Case "45" ColumnName2 = "566,567:500" Case "47" ColumnName2 = "566,567:550" Case "48" ColumnName2 = "566,567:GP-12" Case "49" ColumnName2 = "568:100" Case "50" ColumnName2 = "568:150" Case "51" ColumnName2 = "568:200" Case "52" ColumnName2 = "568:250" Case "53" ColumnName2 = "568:300" Case "54" ColumnName2 = "568:350" Case "55" ColumnName2 = "568:400" Case "56" ColumnName2 = "568:450" Case "57" ColumnName2 = "568:500" Case "58" ColumnName2 = "568:525" Case "59" ColumnName2 = "568:550" Case "60" ColumnName2 = "568:GP-12" Case "61" ColumnName2 = "Duramax"

Case "63"
    ColumnName2 = "Regrind"
Case "64"
    ColumnName2 = "Salvage/Teardown:GM Teardowns"
Case "65"
    ColumnName2 = "Salvage/Teardown:Denso Teardowns"
Case "66"
    ColumnName2 = "Salvage/Teardown:Ford Box Filter Teardowns"
Case "67"
    ColumnName2 = "Salvage/Teardown:Ford DFCM Teardown"
Case "68"
    ColumnName2 = "Salvage/Teardown:Chrysler Teardowns"
Case "69"
    ColumnName2 = "Salvage/Teardown:Subaru"
Case "70"
    ColumnName2 = "Teamleader:803 T/l Training Checklist"
Case "71"
    ColumnName2 = "Teamleader:Management 101"
Case "72"
    ColumnName2 = "Teamleader:Fundamentals of Crew Leadership"
Case "73"
    ColumnName2 = "Teamleader:VALUE STREAMING MAPPING"
Case "74"
    ColumnName2 = "Spin Welder:Operator I"
Case Else
    ColumnName2 = "Area:Qualfication"

End Select
End Function

Notes:

Look up tables are used to manage the many to many relationships because it's easier to integrate mass training entry and they're still easily query-able.