For years I managed a list of the integrated circuits I own in an Excel spreadsheet. I wanted to add hierarchical information to the list, including specifications, attributes, pinout images, and links to datasheets. While this is possible in Excel, it is much better handled by a database.
I had a look at various free applications, including inventory management, but found nothing that would give me the functionality I wanted.
Having done a fair amount of Access database development in the 1990s, I decided to use Access as the platform for a Components Database. This would give me the flexibility to edit at the data table level and easily make changes to the front-end as required.
In addition to organising the data and making it searchable, I wanted to be able to physically locate a part quickly in on of my component drawers / trays, as I have far too many to simply search for a label visually (see photo below). I thought about using barcodes, as I have a scanner, but quickly rules that out when I discovered that a simple reference system would be better.
The drawers have limited space for a label. I wanted to see the part number on the label, which left too little space for a barcode. In addition to that is the fact that a human cannot read a barcode, so you would always need a scanner to check the drawer reference.
So instead I decided to give each set of drawers an alpha character, e.g. A, B, C, D. Then I numbered the drawers according to row and column. This meant that I could very quickly locate a drawer and thus a component, by a 3 digit alphanumeric code.
I have a Brother P-Touch P750W label printer, so I printed labels for each drawer (work in progress).
This code is then used in the database (top right pink box), with a number after the dot denoting the section of the drawer the component is in.
The files (images, datasheets) are organised under a single root folder, with subfolders for each category and type. Clicking the PDF icon opens the datasheet in the default PDF application (Adobe Reader for me).
Supporting forms:
What started out as a simple idea turned into a complicated beast very quickly once I remembered how to enhance the front-end with VBA! See below for the code I wrote just for the main components form above!
VBA code for the main components form.
VB
Option Compare Database
Option Explicit
Private Sub cmbCategory_AfterUpdate()
If (cmbCategory.Value = 0 Or IsNull(cmbCategory.Value)) Then
cmbType.RowSource = ""
cmbType.Value = 0
Else
cmbType.Value = 0
cmbType.RowSource = "qryTypesForCategory"
cmbType.Requery
End If
Call cmbType_AfterUpdate
End Sub
Private Sub cmbSubType_AfterUpdate()
On Error GoTo ImageError
If (Not IsNull(cmbSubType.Column(2)) And cmbSubType.Column(2) <> "") Then
imgComponent.Picture = Left(Application.CurrentProject.Path, InStrRev(Application.CurrentProject.Path, "\") - 1) & cmbSubType.Column(2)
Else
imgComponent.Picture = Left(Application.CurrentProject.Path, InStrRev(Application.CurrentProject.Path, "\") - 1) & "\Files\DefaultTypeImage.jpg"
End If
Exit Sub
ImageError:
MsgBox "Error loading the image: " & Left(Application.CurrentProject.Path, InStrRev(Application.CurrentProject.Path, "\") - 1) & cmbSubType.Column(2), vbCritical, "Error loading image"
End Sub
Private Sub cmbType_AfterUpdate()
If (cmbType.Value = 0 Or IsNull(cmbType.Value)) Then
cmbSubType.RowSource = ""
cmbSubType.Value = 0
Else
cmbSubType.Value = 0
cmbSubType.RowSource = "qrySubTypesForType"
cmbSubType.Requery
End If
End Sub
Private Sub cmbRemoveFilter_Click()
Me.FilterOn = False
Me.Filter = ""
cmbRemoveFilter.Visible = False
lblRecordCount.BackColor = &HFFFFFF
lblRecordCount.ForeColor = &H666666
End Sub
Private Sub cmbCategory_GotFocus()
cmbCategory.Requery
End Sub
Private Sub cmbCategory_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmbCategory.Dropdown
End Sub
Private Sub cmbSection_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmbSection.Dropdown
End Sub
Private Sub cmbContainer_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmbContainer.Dropdown
End Sub
Private Sub cmbManufacturer_GotFocus()
cmbManufacturer.Requery
End Sub
Private Sub cmbManufacturer_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmbManufacturer.Dropdown
End Sub
Private Sub cmbMountType_GotFocus()
cmbMountType.Requery
End Sub
Private Sub cmbMountType_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmbMountType.Dropdown
End Sub
Private Sub cmbPackage_GotFocus()
cmbPackage.Requery
End Sub
Private Sub cmbPackage_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmbPackage.Dropdown
End Sub
Private Sub cmbSubType_GotFocus()
cmbSubType.Requery
End Sub
Private Sub cmbSubType_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmbSubType.Dropdown
End Sub
Private Sub cmbType_GotFocus()
cmbType.Requery
End Sub
Private Sub cmbType_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmbType.Dropdown
End Sub
Private Sub cmdClearDatasheet_Click()
txtDatasheetPath.Value = Null
imgDatasheet.Visible = False
cmdDatasheet.Visible = False
End Sub
Private Sub cmdClose_Click()
DoCmd.Close acForm, Me.Name, acSavePrompt
End Sub
Private Sub cmdCopyRecord_Click()
Dim FieldList As String
Dim SQL As String
Dim CurrentRecordID As Integer
Dim NewRecordID As Integer
On Error GoTo ErrorMessage
CurrentRecordID = txtComponentID.Value
FieldList = "Qty, PartNumber, Description, CategoryID, TypeID, SubTypeID, PackageID, MountTypeID, ManufacturerID, Container, Tray, Section, Location, DatasheetPath"
SQL = "INSERT INTO tblComponent ( " & FieldList & " ) SELECT " & FieldList & " FROM tblComponent WHERE tblComponent.ComponentID = " & CurrentRecordID
CurrentDb.Execute SQL, dbFailOnError
NewRecordID = CurrentDb.OpenRecordset("SELECT @@Identity")(0)
SQL = "INSERT INTO tblSpec ( ComponentID, SpecDescription, UnitPrefixID, UnitID, UnitValue, Spec ) " & _
"SELECT " & NewRecordID & ", tblSpec.SpecDescription, tblSpec.UnitPrefixID, tblSpec.UnitID, tblSpec.UnitValue, tblSpec.Spec " & _
"FROM tblSpec WHERE ComponentID = " & CurrentRecordID & ";"
CurrentDb.Execute SQL, dbFailOnError
SQL = "INSERT INTO tblAttribute ( ComponentID, AttributeName, AttributeValue ) " & _
"SELECT " & NewRecordID & ", AttributeName, AttributeValue " & _
"FROM tblAttribute WHERE ComponentID = " & CurrentRecordID & ";"
CurrentDb.Execute SQL, dbFailOnError
SQL = "INSERT INTO tblImage ( ComponentID, ImageDescription, ImagePath ) " & _
"SELECT " & NewRecordID & ", ImageDescription, ImagePath " & _
"FROM tblImage WHERE ComponentID = " & CurrentRecordID & ";"
CurrentDb.Execute SQL, dbFailOnError
Me.Requery
DoCmd.GoToRecord , "", acLast
Exit Sub
ErrorMessage:
MsgBox err.Description, vbCritical, "Record Duplication Error"
End Sub
Private Sub cmdDatasheet_Click()
Dim BasePath As String
BasePath = Left(Application.CurrentProject.Path, InStrRev(Application.CurrentProject.Path, "\") - 1)
'On Error GoTo DatasheetOpenError
If Not IsNull(txtDatasheetPath.Value) Then
Application.FollowHyperlink BasePath & txtDatasheetPath.Value
End If
Exit Sub
DatasheetOpenError:
MsgBox "The datasheet could not be found."
End Sub
Private Sub cmdDecriptionBreakout_Click()
'DoCmd.OpenForm "frmDescription", acNormal, , "ComponentID = " & Me.ComponentID
DoCmd.OpenForm "frmDescription", acNormal
'frmDescription.Forms.txtDescription = "Hello"
Forms.frmDescription.txtDescription.Value = txtDescription.Value
End Sub
Private Sub cmdDelete_Click()
Dim CurrentRecordID As Integer
Dim SQL As String
CurrentRecordID = txtComponentID.Value
On Error GoTo SqlDeleteError
If (Not Form.NewRecord) Then
If MsgBox("Delete record?", vbYesNo + vbExclamation + vbDefaultButton2, "Warning") = vbYes Then
DoCmd.SetWarnings False
DoCmd.GoToControl Screen.PreviousControl.Name
DoCmd.RunCommand acCmdDeleteRecord
DoCmd.SetWarnings True
SQL = "DELETE FROM tblSpec WHERE ComponentID = " & CurrentRecordID & ";"
CurrentDb.Execute SQL, dbFailOnError
SQL = "DELETE FROM tblAttribute WHERE ComponentID = " & CurrentRecordID & ";"
CurrentDb.Execute SQL, dbFailOnError
SQL = "DELETE FROM tblImage WHERE ComponentID = " & CurrentRecordID & ";"
CurrentDb.Execute SQL, dbFailOnError
If (Me.CurrentRecord > Me.Recordset.RecordCount) Then
DoCmd.GoToRecord , "", acLast
End If
End If
End If
If (Form.NewRecord And Form.Dirty) Then
DoCmd.RunCommand acCmdUndo
End If
Exit Sub
SqlDeleteError:
MsgBox err.Description, vbCritical, "Record Deletion Error"
End Sub
Private Sub cmdDeleteAttribute_Click()
On Error GoTo ErrorMessage
If Not (IsNull(Forms!frmComponent!frmAttributeList!AttributeID)) Then
Dim SQL As String
SQL = "DELETE FROM tblAttribute WHERE AttributeID = " & Forms!frmComponent!frmAttributeList!AttributeID
CurrentDb.Execute SQL, dbFailOnError
frmAttributeList.Requery
End If
Exit Sub
ErrorMessage:
MsgBox err.Description, vbCritical, "Record Delete Error"
End Sub
Private Sub cmdDeleteSpec_Click()
On Error GoTo ErrorMessage
If Not (IsNull(Forms!frmComponent!frmSpecList!SpecID)) Then
Dim SQL As String
SQL = "DELETE FROM tblSpec WHERE SpecID = " & Forms!frmComponent!frmSpecList!SpecID
CurrentDb.Execute SQL, dbFailOnError
frmSpecList.Requery
End If
Exit Sub
ErrorMessage:
MsgBox err.Description, vbCritical, "Record Delete Error"
End Sub
Private Sub cmdEditLock_Click()
If (cmdEditLock.Caption = "Edit") Then
cmdEditLock.Caption = "Lock"
cmdEditLock.BackColor = RGB(192, 79, 21)
Me.AllowEdits = True
Me.AllowDeletions = True
Me.AllowAdditions = True
cmdDeleteSpec.Enabled = True
cmdOpenFrmSpec.Enabled = True
cmdSelectDatasheet.Enabled = True
cmdClearDatasheet.Enabled = True
cmdCopyRecord.Enabled = True
cmdSave.Enabled = True
cmdNewRecord.Enabled = True
cmdDecriptionBreakout.Enabled = True
Forms!frmComponent!frmImage!cmdSelectImageFile.Enabled = True
Forms!frmComponent!frmImage!cmdRemoveImage.Enabled = True
Forms!frmComponent!frmImage!cmdNewRecord.Enabled = True
Forms!frmComponent!frmImage!cmdDeleteRecord.Enabled = True
frmImage.Locked = False
frmSpecList.Locked = False
frmAttributeList.Locked = False
cmdDelete.Enabled = True
Else
If Me.Recordset.RecordCount > 0 Then
cmdEditLock.Caption = "Edit"
cmdEditLock.BackColor = &H929292
Me.AllowEdits = False
Me.AllowDeletions = False
Me.AllowAdditions = False
cmdDeleteSpec.Enabled = False
cmdOpenFrmSpec.Enabled = False
cmdSelectDatasheet.Enabled = False
cmdClearDatasheet.Enabled = False
cmdCopyRecord.Enabled = False
cmdSave.Enabled = False
cmdNewRecord.Enabled = False
cmdDecriptionBreakout.Enabled = False
Forms!frmComponent!frmImage!cmdSelectImageFile.Enabled = False
Forms!frmComponent!frmImage!cmdRemoveImage.Enabled = False
Forms!frmComponent!frmImage!cmdNewRecord.Enabled = False
Forms!frmComponent!frmImage!cmdDeleteRecord.Enabled = False
frmImage.Locked = True
frmSpecList.Locked = True
frmAttributeList.Locked = True
cmdDelete.Enabled = False
End If
End If
End Sub
Private Sub cmdFirstRecord_Click()
DoCmd.GoToRecord , "", acFirst
End Sub
Private Sub cmdLastRecord_Click()
DoCmd.GoToRecord , "", acLast
End Sub
Private Sub cmdNewRecord_Click()
frmAttributeList.Enabled = False
frmAttributeList.Form.AllowAdditions = False
DoCmd.GoToRecord , "", acNewRec
lblRecordCount.Caption = Me.Recordset.RecordCount + 1 & " of " & Me.Recordset.RecordCount + 1 & " * "
End Sub
Private Sub cmdPreviousRecord_Click()
'If (Me.Recordset.AbsolutePosition + 1 > 1) Then
If (Me.CurrentRecord > 1) Then
DoCmd.GoToRecord , "", acPrevious
End If
End Sub
Private Sub cmdNextRecord_Click()
' If you want to have the Next Record button create a new record, just use '<=' below instead.
If (Me.CurrentRecord < Me.Recordset.RecordCount) Then
DoCmd.GoToRecord , , acNext
End If
' Me.NewRecord is 0 for existing records and -1 for new record.
If (Me.NewRecord < 0) Then
lblRecordCount.Caption = Me.Recordset.RecordCount + 1 & " of " & Me.Recordset.RecordCount + 1
End If
End Sub
Private Sub cmdOpenFrmManufacturer_Click()
DoCmd.OpenForm "frmManufacturer", acNormal, "", "", , acNormal
End Sub
Private Sub cmdOpenFrmSpec_Click()
DoCmd.OpenForm "frmSpec", acNormal, "", "", , acDialog, Me.ComponentID
frmSpecList.Requery
End Sub
Private Sub cmdOpenFrmCategory_Click()
DoCmd.OpenForm "frmCategory", acNormal, "", "", , acNormal
End Sub
Private Sub cmdOpenFrmType_Click()
DoCmd.OpenForm "frmType", acNormal, "", "", , acNormal
End Sub
Private Sub cmdOpenFrmSubType_Click()
DoCmd.OpenForm "frmSubType", acNormal, "", "", , acNormal
End Sub
Private Sub cmdOpenFrmMountType_Click()
DoCmd.OpenForm "frmMountType", acNormal, "", "", , acNormal
End Sub
Private Sub cmdOpenFrmPackage_Click()
DoCmd.OpenForm "frmPackage", acNormal, "", "", , acNormal
End Sub
Private Sub cmdSave_Click()
On Error GoTo SaveError
DoCmd.RunCommand acCmdSaveRecord
Exit Sub
SaveError:
MsgBox err.Description, vbCritical, "Failed to save the record"
End Sub
Private Sub cmdSelectDatasheet_Click()
Dim fp As Object
Set fp = Application.FileDialog(msoFileDialogOpen)
Dim BasePath As String
BasePath = Left(Application.CurrentProject.Path, InStrRev(Application.CurrentProject.Path, "\") - 1)
fp.Filters.Clear
fp.Title = "Select Datasheet"
fp.AllowMultiSelect = False
fp.ButtonName = "Select"
'fp.InitialFileName = BasePath & "\Files"
fp.Filters.Add "PDF Files", "*.pdf"
'fp.Filters.Add "All Files", "*.*"
If (fp.Show) Then
txtDatasheetPath.Value = Replace(fp.SelectedItems(1), BasePath, "")
End If
imgDatasheet.Visible = True
cmdDatasheet.Visible = True
End Sub
Private Sub Form_ApplyFilter(Cancel As Integer, ApplyType As Integer)
Me.Recordset.MoveLast
End Sub
Private Sub Form_Current()
Me.Painting = False
If (Me.FilterOn) Then
cmbRemoveFilter.Visible = True
lblRecordCount.BackColor = RGB(192, 79, 21)
lblRecordCount.ForeColor = &HFFFFFF
End If
If (Not IsNull(Me.ComponentID)) Then
If (cmdEditLock.Caption = "Lock") Then
cmdOpenFrmSpec.Enabled = True
End If
frmAttributeList.Enabled = True
frmAttributeList.Form.AllowAdditions = True
Else
cmdOpenFrmSpec.Enabled = False
frmAttributeList.Enabled = False
frmAttributeList.Form.AllowAdditions = False
End If
lblRecordCount.Caption = Me.CurrentRecord & " of " & Me.Recordset.RecordCount
If (cmbCategory.Value = 0 Or IsNull(cmbCategory.Value)) Then
cmbType.RowSource = ""
cmbType.Value = 0
Else
cmbType.RowSource = "qryTypesForCategory"
cmbType.Requery
End If
If (cmbType.Value = 0 Or IsNull(cmbType.Value)) Then
cmbSubType.RowSource = ""
cmbSubType.Value = 0
Else
cmbSubType.RowSource = "qrySubTypesForType"
cmbSubType.Requery
End If
If (IsNull(txtDatasheetPath.Value) Or txtDatasheetPath.Value = "") Then
imgDatasheet.Visible = False
cmdDatasheet.Visible = False
Else
imgDatasheet.Visible = True
cmdDatasheet.Visible = True
End If
On Error Resume Next
Me.frmImage.Form.Painting = False
Me.frmImage.Form.Recordset.MoveLast
Me.frmImage.Form.Recordset.MoveFirst
Me.frmImage.Form.Painting = True
Me.Painting = True
On Error GoTo ImageError
If (Not IsNull(cmbSubType.Column(2)) And cmbSubType.Column(2) <> "") Then
imgComponent.Picture = Left(Application.CurrentProject.Path, InStrRev(Application.CurrentProject.Path, "\") - 1) & cmbSubType.Column(2)
Else
imgComponent.Picture = Left(Application.CurrentProject.Path, InStrRev(Application.CurrentProject.Path, "\") - 1) & "\Files\DefaultTypeImage.jpg"
End If
Exit Sub
ImageError:
MsgBox "Error loading the image: " & Left(Application.CurrentProject.Path, InStrRev(Application.CurrentProject.Path, "\") - 1) & cmbSubType.Column(2), vbCritical, "Error loading image"
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
' Disables the F5 (refresh) keypress, which performs a ReQuery on the form, resetting the psoition of the recordset.
' The form's Key Preview property must be set to Yes for this to work.
If KeyCode = vbKeyF5 Then
KeyCode = 0
End If
End Sub
Private Sub Form_Load()
Me.ShortcutMenu = False
If Me.Recordset.RecordCount > 0 Then
frmImage.Form.AllowAdditions = True
frmImage.Form.AllowEdits = True
frmImage.Form.AllowDeletions = True
frmAttributeList.Form.AllowDeletions = True
frmSpecList.Form.AllowDeletions = True
End If
End Sub
Private Sub Form_Open(Cancel As Integer)
On Error Resume Next
If Me.Recordset.RecordCount > 0 Then
DoCmd.GoToRecord , "", acLast
DoCmd.GoToRecord , "", acFirst
End If
End Sub
Private Sub txtTray_KeyUp(KeyCode As Integer, Shift As Integer)
If (Len(txtTray.Text) > 2) Then
txtTray.Text = Left(txtTray.Text, 2)
End If
End Sub
Public Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
On Error Resume Next
If chkMouseWheelScroll = True Then
If (Count > 0) And (Me.CurrentRecord > 1) Then
DoCmd.GoToRecord , , acPrevious
ElseIf (Count < 0) And (Me.CurrentRecord < Me.Recordset.RecordCount) Then
DoCmd.GoToRecord , , acNext
End If
End If
End Sub
Private Sub cmdSearch_Click()
On Error Resume Next
DoCmd.GoToControl Screen.PreviousControl.Name
DoCmd.RunCommand acCmdFind
End Sub
I obviously didn’t need to go this far, but software development is also a hobby, and I really enjoyed developing this database! The good thing about this is that I have ‘access’ to the relational data stored in the tables, regardless of what I do with the front-end. For example I could migrate the data to MariaDB or any other database backend, and develop a web front-end.
Leave a Reply