Login screen
Client: E3M (France)
Date: January-April 2016
Technlogy: Access, VBA, Excel, Word
Developed for the Bio-Rad company, this database allows to track competing products. You can find the list of Bio-Rad products and a list of competing products. Each competitor product is linked to one or more Bio-Rad products with comments for each. Documents for these products can also be attached. General information is also managed by the database. Export functions to Excel and Word have also been developed.
You also find functions to manage the various tables and a sytem access management and an activity report on the database .
This function allows to link an external document to a competing product or general information. The documents are copied to a specific folder named according to the competitive product identifier competitor or general information identifier.
Function InsertDocumentLink(DocumentType As String, IDDocument As Long, DocumentName As String, Optional Confidential As Boolean = False) As Boolean
Dim strTableName As String
Dim strIDName As String
Dim intActivityType As LogActivityTypeID
Dim strActivityDescription As String
Dim db As Database
Dim rs As DAO.Recordset
Dim sSQL As String
Dim bReturnValue As Boolean
bReturnValue = False
Select Case DocumentType
Case "ConcurrentProduct"
strTableName = "ProduitConcurrent_Documents"
strIDName = "IDProduitConcurrent"
intActivityType = AddConcurrentProductDocument
strActivityDescription = "Document " & DocumentName & " added to concurrent product " & modMain.GetConcurrentProductName(IDDocument)
Case "GeneralInfo"
strTableName = "InfoGenerale_Documents"
strIDName = "IDInfoGenerale"
intActivityType = AddGeneralInfoDocument
strActivityDescription = "Document " & DocumentName & " added to general information " & modMain.GetGeneralInfoTitle(IDDocument)
Case Else
strTableName = ""
strIDName = ""
End Select
If strTableName <> "" Then
Set db = CurrentDb
sSQL = "INSERT INTO [" & strTableName & "] (" & strIDName & ", DocumentFilename, ProprietaryID, IsConfidential) VALUES (" & _
IDDocument & ",'" & DocumentName & "'," & gCurrentLogUserID & "," & xBoolean(Confidential) & ")"
db.Execute sSQL
Call modMain.SetActivityLog(intActivityType, strActivityDescription)
Set db = Nothing
bReturnValue = True
End If
InsertDocumentLink = bReturnValue
End Function
This function is use to filter the list of competing products accordingly to different criteria.
Private Sub FilterData()
Dim sSQL As String
Dim sSQLWhere As String
Dim sSQLOrderBy As String
sSQL = "SELECT Produits_Concurrent.IDProduitConcurrent, Produits_Concurrent.NomProduitConcurrent AS [Nom du produit], " & _
"Concurrent_Enterprise.ConcurrentEnterpriseName AS Entreprise FROM Produits_Concurrent " & _
"LEFT JOIN Concurrent_Enterprise ON Produits_Concurrent.IDConcurrentEnterpriseName = Concurrent_Enterprise.ID_ConcurrentEnterprise "
sSQLOrderBy = " ORDER BY Produits_Concurrent.[NomProduitConcurrent]"
FilterDataType = "All"
'Filter by Bio-Rad Product Code
If Not IsNull(Me.cboProduits_Bio_RAd.Value) Then
sSQL = "SELECT Produits_Concurrent.IDProduitConcurrent, Produits_Concurrent.NomProduitConcurrent AS [Nom du produit], " & _
"Concurrent_Enterprise.ConcurrentEnterpriseName As Entreprise " & _
"FROM Concurrent_Enterprise INNER JOIN ([Produits_Bio-Rad] INNER JOIN (Produits_Concurrent INNER JOIN Produit_BioRad_Lie " & _
"ON Produits_Concurrent.IDProduitConcurrent = Produit_BioRad_Lie.IDProduitConcurrent) " & _
"ON [Produits_Bio-Rad].IDProduit = Produit_BioRad_Lie.IDProduitBioRad) " & _
"ON Concurrent_Enterprise.ID_ConcurrentEnterprise = Produits_Concurrent.IDConcurrentEnterpriseName "
sSQLWhere = "WHERE (((Produit_BioRad_Lie.IDProduitBioRad)=" & Me.cboProduits_Bio_RAd.Value & "))"
FilterDataType = "Product Code=" & Me.cboProduits_Bio_RAd.Column(1)
End If
If Trim(Me.tboProductName) <> "" Then
sSQL = "SELECT DISTINCT Produits_Concurrent.IDProduitConcurrent, Produits_Concurrent.NomProduitConcurrent AS [Nom du produit], " & _
"Concurrent_Enterprise.ConcurrentEnterpriseName As Entreprise " & _
"FROM Concurrent_Enterprise INNER JOIN ([Produits_Bio-Rad] INNER JOIN (Produits_Concurrent INNER JOIN Produit_BioRad_Lie " & _
"ON Produits_Concurrent.IDProduitConcurrent = Produit_BioRad_Lie.IDProduitConcurrent) " & _
"ON [Produits_Bio-Rad].IDProduit = Produit_BioRad_Lie.IDProduitBioRad) " & _
"ON Concurrent_Enterprise.ID_ConcurrentEnterprise = Produits_Concurrent.IDConcurrentEnterpriseName "
sSQLWhere = "WHERE (([Produits_Bio-Rad].NomProduit LIKE '*" & Trim(tboProductName) & "*'" & "))"
FilterDataType = "Product Name=" & Trim(tboProductName)
End If
If Not IsNull(Me.cboItemGroups.Value) Then
sSQL = "SELECT Produits_Concurrent.IDProduitConcurrent, Produits_Concurrent.NomProduitConcurrent AS [Nom du produit], " & _
"Concurrent_Enterprise.ConcurrentEnterpriseName AS Entreprise, ItemGroups.IDItemGroup " & _
"FROM (Concurrent_Enterprise INNER JOIN ([Produits_Bio-Rad] INNER JOIN (Produits_Concurrent " & _
"INNER JOIN Produit_BioRad_Lie ON Produits_Concurrent.IDProduitConcurrent = Produit_BioRad_Lie.IDProduitConcurrent) " & _
"ON [Produits_Bio-Rad].IDProduit = Produit_BioRad_Lie.IDProduitBioRad) " & _
"ON Concurrent_Enterprise.ID_ConcurrentEnterprise = Produits_Concurrent.IDConcurrentEnterpriseName) " & _
"INNER JOIN ItemGroups ON [Produits_Bio-Rad].IDItemGroup = ItemGroups.IDItemGroup "
sSQLWhere = "WHERE (((ItemGroups.IDItemGroup)=" & Me.cboItemGroups.Value & "))"
FilterDataType = "Item Groups=" & Me.cboItemGroups.Column(1)
End If
If Not IsNull(Me.cboListeEntreprise.Value) Then
If sSQLWhere = "" Then
sSQLWhere = " WHERE Concurrent_Enterprise.ConcurrentEnterpriseName ='" & Me.cboListeEntreprise.Column(1) & "'"
Else
sSQLWhere = sSQLWhere & " AND Concurrent_Enterprise.ConcurrentEnterpriseName ='" & Me.cboListeEntreprise.Column(1) & "'"
End If
If FilterDataType = "All" Then
FilterDataType = "Entreprise=" & Me.cboListeEntreprise.Column(1)
Else
FilterDataType = FilterDataType & " AND Entreprise=" & Me.cboListeEntreprise.Column(1)
End If
End If
Me.Liste1.RowSource = sSQL & sSQLWhere & sSQLOrderBy
Me.Liste1.Requery
End Sub
This function allows to export the list of competing products to Excel.
Private Sub ExportToExcel()
Dim oExcel As Excel.Application
Dim oWorkBook As Excel.Workbook
Dim oWorksheet As Excel.Worksheet
Dim i As Integer
Dim j As Integer
Dim strColumnNo As String
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = True
Set oWorkBook = oExcel.Workbooks.Add()
Set oWorksheet = oWorkBook.Sheets.Add
'Titles
oWorksheet.Cells(1, 1) = "Competitive Product List"
oWorksheet.Range("A1").RowHeight = 24
oWorksheet.Range("A1").Font.Size = 18
oWorksheet.Range("A1").Font.Bold = True
oWorksheet.Range("A1").HorizontalAlignment = xlCenter
oWorksheet.Range("A1:" & Chr(Asc("A") + (Me.Liste1.ColumnCount - 2)) & "1").Merge
oWorksheet.Cells(2, 1) = "Criteria: " & FilterDataType
oWorksheet.Range("A2").RowHeight = 36
oWorksheet.Range("A2").Font.Size = 12
oWorksheet.Range("A2").Font.Bold = True
oWorksheet.Range("A2").VerticalAlignment = xlCenter
'Column Header
strColumnNo = "A"
For i = 1 To Me.Liste1.ColumnCount - 1
oWorksheet.Range(strColumnNo & "1").ColumnWidth = 40
oWorksheet.Range(strColumnNo & "4").Font.Bold = True
oWorksheet.Cells(4, i) = Me.Liste1.Column(i, 0)
strColumnNo = Chr(Asc(strColumnNo) + 1)
Next i
'Data
For j = 1 To Me.Liste1.ListCount - 1
strColumnNo = "A"
For i = 1 To Me.Liste1.ColumnCount - 1
oWorksheet.Cells(j + 4, i) = Me.Liste1.Column(i, j)
strColumnNo = Chr(Asc(strColumnNo) + 1)
Next i
Next j
oWorksheet.Range("A1").Select
'oWorkBook.SaveAs strFilename
'Release objects
Set oExcel = Nothing
Set oWorksheet = Nothing
Set oWorkBook = Nothing
End Sub
