phase_2_feb18_notes - x-ian/dha-mis-migration GitHub Wiki
At the end of phase 1 the (database) permissions for users were set to sys_admin for every Active Directory (AD) Domain User. It was clear that this needs to change, but as most users use the dedicated frontends (admin, analyse, data entry) where access is is already limited, it wasn't a high priority to address at phase 1.
The initial integration of Active Directory and MSSQL allows to 'outsource' of the user and permissions management mostly to AD users. 'Trusted Connections' are already used to automatically grant access to DHAMIS whenever a valid AD user is accessing it.
Now additionally database roles ('principals') have been defined. Every user of the default AD group 'Domain Users' is already granted with readonly access to the DB via the mapping to the MSSQL role 'DHA Readonly'. Additionally the database roles 'DHA User' and 'DHA Admin' map to the additional (and optional) AD groups (OU - org units) 'DHA Admin' and 'DHA User'. Whereas the role 'DHA Readonly' grants select permissions to every table, the role DHA User has additional change permissions (INSERT, UPDATE, DELETE) to the table necessary for members of PSM and data entry. The role 'DHA Admin' finally has write permission to every table, including the ones like concept or map_users to fully access/customize/config DHA-MIS.
Besides the DHA-MIS roles every user of the AD group 'Domain Admin' is attached to the MSSQL role 'sys_admin'.
MSSQL offers several different and flexible ways to authenticate and authorize users. For DHA-MIS the following process is used ((https://dba.stackexchange.com/questions/2572/how-do-i-assign-an-entire-active-directory-group-security-access-in-sql-server-2)):
- Create AD groups (org units), for now DHA Admin and DHA User
- Create DB global logins, for now DHA Admin, DHA User and Domain Users
- Create DB specific user for each login, DHA Admin, DHA User, DHA Readonly (note that unlike the name DB user indicates this doesn't need to be a concrete user, but can also act as a placeholder for all users of a specific AD group)
- Create DB specific roles for each
Note: Changing AD group memberships requires a Windows logout/login for users to become active (as the membership is part of Kerberos token which is generated during logins).
Once the above settings to AD and MSSQL are created, ordinary SQL permissions (like SELECT, INSERT, UPDATE, DELETE) can be granted (or revoked) to these roles. Although MSSQL allows to assign permission even on a column level, DHA-MIS only makes use of table-level permissions. So for every table and MSSQL view (currently around 65) and every DB role (currently 3) one GRANT (and potentially a previous REVOKE statement to reset previous permissions) need to be created (or clicked through the UI). To simply this process the table permissions is created. This table has a row for every table or view and columns for every role. In the cells the permissions can be defined. The VBA script 'ReapplyPermissions' iterates over these cells and generates matching GRANT and REVOKE statements. For now these statements need to be manually copy and executed on MSSQL to activate.
It is thinkable to have this manual step also be done automatically, e.g. through the admin frontend.
Table permissions Columns ID, table, dha_readonly, dha_user, dha_admin LookupColumn table: SELECT msysobjects.name FROM msysobjects WHERE type = 4; (all linked ODBC tables) LookupColumns role_dha_*: noaccess;read;write
VB module ReapplyPermissions:
Option Compare Database
Option Explicit
Sub main_reapply_permissions()
Dim Rs As Recordset
Dim table As String
Dim readonly As String
Dim user As String
Dim data_entry As String
Dim care_and_treatment As String
Dim logistics As String
Dim program_officer As String
Dim admin As String
Dim typ As String
Set Rs = CurrentDb.OpenRecordset("internal_permissions", dbOpenDynaset, dbSeeChanges)
'populate the table
Rs.MoveLast
Rs.MoveFirst
Do While Not Rs.EOF
table = Rs!table
readonly = Rs!role_dha_readonly
user = Rs!role_dha_user
data_entry = Rs!role_dha_data_entry
program_officer = Rs!role_dha_program_officer
care_and_treatment = Rs!role_dha_care_and_treatment
logistics = Rs!role_dha_logistics
admin = Rs!role_dha_admin
' revoke permissions for dha_user and _readonly, ignore _admin for now (unsure if we could lock ourselves out)
Call revokePermissions(table, "dha_user")
Call revokePermissions(table, "dha_readonly")
Call revokePermissions(table, "dha_program_officer")
Call revokePermissions(table, "dha_data_entry")
Call revokePermissions(table, "dha_logistics")
Call revokePermissions(table, "dha_care_and_treatment")
'Call revokePermissions(table, "dha_admin")
' apply new permissions
Call grantPermissions(table, "dha_user", user)
Call grantPermissions(table, "dha_data_entry", data_entry)
Call grantPermissions(table, "dha_program_officer", program_officer)
Call grantPermissions(table, "dha_care_and_treatment", care_and_treatment)
Call grantPermissions(table, "dha_logistics", logistics)
Call grantPermissions(table, "dha_readonly", readonly)
Call grantPermissions(table, "dha_admin", admin)
Rs.MoveNext
Loop
End Sub
Private Sub revokePermissions(table As String, role As String)
Debug.Print "REVOKE SELECT, INSERT, UPDATE, DELETE ON " & table & " FROM " & role & ";"
End Sub
Private Sub grantPermissions(table As String, role As String, permissions As String)
Dim p As String
If permissions = "noaccess" Then
Exit Sub
ElseIf permissions = "read" Then
p = "SELECT"
ElseIf permissions = "write" Then
p = "SELECT, INSERT, UPDATE, DELETE"
End If
Debug.Print "GRANT " & p & " ON " & table & " TO " & role & ";"
End Sub
Not necessary, but maybe helpful. Showing all permissions and roles to a MSSQL login:
EXECUTE AS LOGIN = N'MOHHIV\DHA Admin';
GO
DECLARE @login NVARCHAR(256), @user NVARCHAR(256);
SELECT @login = login_name FROM sys.dm_exec_sessions WHERE session_id = @@SPID;
SELECT @user = d.name
FROM sys.database_principals AS d
INNER JOIN sys.server_principals AS s
ON d.sid = s.sid
WHERE s.name = @login;
SELECT u.name, r.name
FROM sys.database_role_members AS m
INNER JOIN sys.database_principals AS r
ON m.role_principal_id = r.principal_id
INNER JOIN sys.database_principals AS u
ON u.principal_id = m.member_principal_id
WHERE u.name = @user;
SELECT class_desc, major_id, permission_name, state_desc
FROM sys.database_permissions
WHERE grantee_principal_id = USER_ID(@user);
GO
Print all AD memberships from command line: gpresult /V
select * from sys.login_token where name like 'MOHHIV\DHA%'
select distinct(name) from sys.login_token where name like 'MOHHIV\DHA%'
With the move from the Access backend to MSSQL the easy way to have a completely offline and workstation local installation of the DB disappeared. During phase 1 a substitute process of installation a local MSSQL edition (MS SQL Server Express) was created. This requires a couple of manual initial installation steps, implies a less than lightweight installation environment (by requiring a MSSQL service running on the workstation all the time), and requires a slightly sophisticated automated process to update the local database with the most recent live database snapshot.
Recently MSSQL introduces a new deployment variant called LocalDB. With this the MS ODBC driver basically embeds the MSSQL server engine and restores the MSSQL environment whenever a special ODBC connection string is used. This is transparent to the user and can read straight from the binary MSSQL database files (.mdf and .ldf). MSSQL Database file can be directly attached to a LocalDB instance, so that taking the live database offline is achieved by mostly copying the physical database files. (However to copy the live database from the server, the server instance needs to be stopped first.)
Note: LocalDB the same limitations as MSSQL 2014 Express version (1 GB of memory, 1 CPU or 4 cores, 10 GB of database file sizes (incl log file)). Unclear if MSSQL Developer version could also be used. Doesn't seem to have limits in used resources, but is not labeled as 'for production' (although maybe DHA's use case might not be a typical production setup). But it looks as if the Developer Edition requires permanent online access to local networks licensing server (?).
Note that the bundled version 13.0 of the MS ODBC driver with MSSQL 2014 (and 2016?) has a bug with automatic DB instance creation. So either version 11.0 or 13.1 should be used. Connections weren't accepted, but switching back to ODBC v11 worked; potentially v13.1 fixes this. So for now like this: ODBC;DRIVER=ODBC Driver 11 for SQL Server;SERVER=(localdb)\MSSQLLocalDB;DATABASE=HIVData-live;Trusted_Connection=Yes;OPTION=3;
In case the automatic DB instance creation is used (recommend as the decreases the required config steps, but also requires changes to the Access frontend) ODBC;DRIVER=ODBC Driver 11 for SQL Server;Server=(LocalDB)\MSSQLLocalDB;Integrated Security=true;AttachDbFileName=D:\Data\MyDB1.mdf"
A running LocalDB instance can be connected to via the SSMS or a (potentially only workstation-local) ODBC connection. The server name for a MSSQL 2014 is (localdb) and its default DB instance is named MSSQLLocalDB. Hence with the server connection string of (localdb)\MSSQLLocalDB it is possible to connect.
Compacting MSSQL database is helpful to reduce claimed disk space before copy/pasting to LocalDB; maybe a simple automated nightly dump of the live DB to a dedicated folder is enough.
LocalDB is managed (if necessary) through the command line sqllocaldb.exe or the SSMS https://docs.microsoft.com/en-us/sql/database-engine/configure-windows/sql-server-2016-express-localdb sqllocaldb.exe i sqllocaldb i MSSQLLocalDB sqllocaldb c | d MSSQLLocalDB sqllocaldb s MSSQLLocalDB (localdb)\MSSQLLocalDB
Attach MDF file through SSMS or via sqlcmd: https://technet.microsoft.com/en-us/library/ms165673(v=sql.105).aspx
The existing VB module Database Backup Selector is already able to set up such connections; by simply using (localdb)\MSSQLLocalDB as server with instance HIVData-live and a Trusted connection.
Invoking the above connection for the first time implicitly creates the default instance MSSQLLocalDB on the system. Subsequent connections, also from the Access frontends, do not require the AttachDbFilename parameter anymore as the default instance MSSELLocalDB is now permanently configured.
Connection via SSMS for autmated initial DB instance creation Login: (localdb)\MSSQLLocalDB Win Auth Connection Properties. Connect to database: HIVData-live AttachDbFilename=c:\Users\cmkandawire\Documents\HIVData-live.mdf
The Query Builder (and export) tool allows generic access to every data point from the various Services deliveries. Besides creating summary reports whole data sets can be exported in a datasheet and Excel view.
However especially the speed of the bulk export seems improvable (depending on network and/or hard disk speed) a more complex export can take 10 minutes and more. The query analysis showed that a lot of data is going over the network (>500 MB for an above query). So the performance is heavily tied to the network speed or the speed of local hard drive if the Offline version of DHAMIS is used.
The uery uses temporary (frontend-) local Access tables and combines them with multiple joins to server-side tables. Access doesn't do a good job in optimizing such a situation and is doing a (partial) full-table scan to process the data locally. Rearranging this query and introducing a MSSQL view gives Access 'hints' to prevent this excessive data transfer. With such performance improvements of 50% and more were gained.
It is additionally noted that especially for the Offline version (which usually provides highest speed), switching the local computer's hard disk to a Solid State Disk (SSD) will increase the speed further.
DHAMIS needs to be robust with varying backend DB connections. If a frontend is configured to connect Live DB, but is no in the local network, then a switch to Offline DB needs to be possible. Similarily a switch to Offline DB should only work when the MSSQLLocalDB is available.
Errors during initial ODBC connections are hard to catch within Access. A workaround with opening a 2nd ODBC connection (this time via ADODB) is implemented. A failing backend connection requires to wait for a timeout and then proceed.
Note that the Tabs of the Custom Ribbon also need backend connectivity to determine if if they should be shown for a particular user and its role or not.
As much as possible the different constellations are tired to caught in the Ribbon-related code as well as during switching DBs. Additionally a new startup form called AutoExec is used to do the initial backend checks and once they are successful, it opens the Homepage form.
Form_Switchboard: replace Form_load with this: Private Sub Form_Load() If runningOnAccessRuntime Then On Error GoTo ERROR_HANDLER_RUNTIME ' GENERATED ERROR
' capture height offset for later rearrange to dynamically add scrollbars heightOffsetOption1 = Me("Option1").Top distanceBetweenOptions = Me("Option2").Top - Me("Option1").Top
If Not IsBackendConnectionWorking() Then Dim text As String If IsLiveDatabase() Then text = "Connection to Live DB failed. Do you want to try switching to Offline DB (Yes) or Exit (No)?" Else text = "Connection to Offline DB failed. Do you want to try switching to Live DB (Yes) or Exit (No)?" End If If MsgBox(text, vbYesNo) = vbYes Then cmdQuickSwitchLive_Click Else Application.Quit End If End If
Call RefreshConnectionDetails
' allowing keyboard navigation Me.KeyPreview = True
DoCmd.Maximize Exit Sub ' GENERATED ERROR HANDLER ERROR_HANDLER_RUNTIME: ' GENERATED ERROR HANDLER MsgBox "Error happened: " & Err.Description & " " & Err.Number ' GENERATED ERROR HANDLER End Sub
Add to Module RelinkTables Function IsBackendConnectionWorking() On Error GoTo TestError
'Dim dbs As DAO.Database Dim qdf As DAO.QueryDef Dim connectString As String Dim objConn As Object
Set qdf = CurrentDb.QueryDefs("internal_current_user") connectString = qdf.Connect
' Use ADODB to open another connection as this allows to catch/trap errors from VBA (unlike the default DAO ) Set objConn = CreateObject("ADODB.Connection") ' use ODBC from existing DAO link, but throw away the ODBC; prefix objConn.Open Replace(connectString, "ODBC;", "") '"DRIVER=ODBC Driver 13 for SQL Server;SERVER=XIANWIN7\SQLEXPRESS;Trusted_Connection=Yes;DATABASE=HIVData-live", "a", "b"
IsBackendConnectionWorking = True Exit Function
TestError: ' MsgBox Err.Description IsBackendConnectionWorking = False Exit Function End Function
A new simplistic landing page / homepage was added to welcome to user and make use of the screen space which became available after the old switchboard menus were removed.
This could be used to add more of a Dashboard-like view and a graphically less appealing attempt was implemented in the Form homepage_full.
Create hidden Form AutoExec
Private Sub Form_Current()
Dim db As DAO.Database
Set db = CurrentDb
If IsLiveDatabase() Then
db.Properties("AppTitle").value = "DHAMIS - Live DB (" & db.Properties("Name").value & ")"
Else
db.Properties("AppTitle").value = "DHAMIS - Local DB (" & db.Properties("Name").value & ")"
End If
Application.RefreshTitleBar
End Sub
UI elements should be enabled or disabled based on the AD role of the user.
Create Frontend SQL passthrough query internal_current_roles
select distinct(substring(name, 8, 99)) from sys.login_token where name like 'MOHHIV\DHA%'
Used by Ribbon VBA code further down
showing switchboard menuitem based on role
exec sp_helpuser 'MOHHIV\cneumann'
exec sp_helpuser 'DHA Admin'
select
[Login Type]=
case sp.type
when 'u' then 'WIN'
when 's' then 'SQL'
when 'g' then 'GRP'
end,
convert(char(45),sp.name) as srvLogin,
convert(char(45),sp2.name) as srvRole,
convert(char(25),dbp.name) as dbUser,
convert(char(25),dbp2.name) as dbRole
from
sys.server_principals as sp join
sys.database_principals as dbp on sp.sid=dbp.sid join
sys.database_role_members as dbrm on dbp.principal_Id=dbrm.member_principal_Id join
sys.database_principals as dbp2 on dbrm.role_principal_id=dbp2.principal_id left join
sys.server_role_members as srm on sp.principal_id=srm.member_principal_id left join
sys.server_principals as sp2 on srm.role_principal_id=sp2.principal_id
SELECT p.name AS [loginname] ,
p.type , p.type_desc ,
p.is_disabled,
CONVERT(VARCHAR(10),p.create_date ,101) AS [created],
CONVERT(VARCHAR(10),p.modify_date , 101) AS [update]
FROM sys.server_principals p
JOIN sys.syslogins s ON p.sid = s.sid
--WHERE p.type_desc IN ('SQL_LOGIN', 'WINDOWS_LOGIN', 'WINDOWS_GROUP')
-- Logins that are not process logins
AND p.name NOT LIKE '##%' -- Logins that are sysadmins
AND s.sysadmin = 1
sELECT p.NAME, m.NAME
FROM sys.database_role_members rm
JOIN sys.database_principals p ON rm.role_principal_id = p.principal_id
JOIN sys.database_principals m ON rm.member_principal_id = m.principal_id
Moving from Switchboard to Office Ribbons for menus.
Ribbon customization is kept in XML file and stored in hidden Access table USysRibbon. (Hint: If the Ribbon gets corrupted (or the IDBE RibbonCreator fails), delete the contents of table USysRibbon.)
No out-of-the-box graphical Ribbon Editor is part of Office. To not edit the XML manually an external commercial tool named IDBE RibbonCreator (http://www.ribboncreator2016.de/, ~US $ 40) was used. Alternatively Visual Studio 'Office Developer Tools for Visual Studio' is a 5 GB install (which requires .NET 4.6 install) and should have a Ribbon Designer too. There is another (?) Visual Studio addon called 'Visual Studio 2010 Tools for Office Runtime' which claims to also be compatible with Office 2016. No Visual Studio was tested (https://msdn.microsoft.com/en-us/library/bb386089.aspx)
To activate the display of error messages in Ribbon XML: File - Options - Client Settings - General - Show add-in user interface errors. Otherwise loading of invalid Ribbon XML will silently fail.
Custom Ribbons are not opened in Access Design Mode (when holding the SHIFT key during database load). But the Ribbons can be load also during Form load of a Form. So attaching the Ribbon to the Homepage Form and opening it will bring back the Ribbons in Design Mode.
The IDBE RibbonCreator creates a single Event handler procedure. As a default this is called by every (button) / ribbon entry and receives the ControlID as a parameter. Keeping the Switchboard style approach this control ID could then be looked up in a Switchboard Items table (or similar) to decide which action to invoke (open form, report, or run macro are currently used). But if the ControlID already has the action included in its name, such an indirection isn't needed anymore. E.g. a ribbon button named btnReport_report_qrybuild already has the action included and can be parsed and invoked by the generic onAction event handler. If custom coding is needed for a particular button, then this one could always be configured with its own dedicated event onAction handler.
Besides creating new Custom Ribbons the 'Backstage Menu' (File) can title bar can be configured through the Ribbon XML. The most recent version of the RibbonXML is in dhamis-ribbon.xml
onAction callback code
' Belongs to basRibbonCallbacks
Sub OnActionButton(control As IRibbonControl)
Call handleRibbonButton(control)
End Sub
' Belongs to RibbonCustomization
Public Sub handleRibbonButton(control As IRibbonControl)
If InStr(control.ID, "btn_Form_") = False And InStr(control.ID, "btn_Report_") = False And InStr(control.ID, "btn_Macro_") = False Then
MsgBox "Invalid Format for Control ID (required format btn[Form|Report|Macro]): " & control.ID
Exit Sub
End If
Dim Command As String
Command = Mid(control.ID, 5, InStr(5, control.ID, "_") - 5)
Dim accessObject As String
accessObject = Right(control.ID, Len(control.ID) - InStr(5, control.ID, "_"))
Select Case Command
Case "Form"
DoCmd.OpenForm accessObject
Case "Report"
'DoCmd.OpenForm accessObject
DoCmd.OpenReport accessObject, acPreview
Case "Macro"
DoCmd.RunMacro accessObject
Case Else
MsgBox "Invalid Format for Control ID (required format btn[Form|Report|Macro]): " & control.ID
End Select
End SubAdditionally controls can be shown or hidden depending on the current role of the user. It seems overkill to decide this for every single ribbon entry. Grouping the ribbon items in Tabs and deciding for each tab if a particular role is allowed to see the tab is more straight forward.
GetVisible callback code
' belongs to basRibbonCallbacks
Sub GetVisible(control As IRibbonControl, ByRef visible)
Call hasRibbonPermissionVisible(control, visible)
End Sub
' belongs to RibbonCustomization
Public Function hasRole(isUser As Boolean, isProgramOfficer As Boolean, isDataEntry As Boolean, isLogistics As Boolean, isCareAndTreatment As Boolean, isAdmin As Boolean)
Dim db As DAO.Database, rs As DAO.Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("internal_current_roles", dbOpenSnapshot)
rs.MoveFirst
Do While Not rs.EOF
Select Case rs![Expr1000]
Case "DHA Admin"
If isAdmin Then hasRole = True
Case "DHA User"
If isUser Then hasRole = True
Case "DHA Data Entry"
If isDataEntry Then hasRole = True
Case "DHA Logistics"
If isLogistics Then hasRole = True
Case "DHA Program Officer"
If isProgramOfficer Then hasRole = True
Case "DHA Care and Treatment"
If isAdmin Then hasRole = True
Case "db_owner"
hasRole = True
Exit Function
Case Else
MsgBox "Unknown role " & rs![name]
End Select
rs.MoveNext
Loop
End Function
Public Sub hasRibbonPermissionVisible(control As IRibbonControl, ByRef visible)
' for now limit to contraols starting with tab
If Left(control.ID, 3) <> "tab" Then
visible = True
Exit Sub
End If
Select Case control.ID
Case "tabAnalyse"
visible = hasRole(True, True, False, True, True, True)
Case "tabSupplyManagement"
visible = hasRole(False, False, False, True, False, True)
Case "tabDataEntry"
visible = hasRole(False, True, True, True, True, True)
Case "tabAdmin"
visible = hasRole(False, False, False, False, False, True)
Case "tabFrontendMaintenance"
visible = hasRole(False, False, False, False, False, True)
Case Else
visible = False
End Select
End SubMore links/resources:
- http://www.accessribbon.de/en/?FAQ
- https://msdn.microsoft.com/en-us/library/bb386097.aspx
- https://stackoverflow.com/questions/25641532/database-specific-custom-ribbon-not-loading
Activate "Show add-in user interface errors" to show errors in Ribbon XML (otherwise it will be silently ignored). Set it e.g. from Word via File - Options - Advanced - Show add-in user interface errors" (in section General). This is a per user setting (per system) for all Office applications.
If the XML for the Custom Ribbon is corrupt / has mistakes, then typically Access complains while opening the DB with 'error found in custom ui xml ...'. There is no (obvious?) place to delete such a defect XML Ribbon. Go to the (hidden?) table USysRibbon and delete the records from there.
Show hidden Access table USysRibbon.
Not (easily) possible on a per-role basis.
Ideally:
- hide application ribbon for everybody except m&e and admin
- hide external data tab for m&e
Ribbon customization through File - Option is global for every Access database
Add to Ribbon XML. Careful: IDBE RibbonCreator isn't capable of this; so it will overwrite them
<tab idMso="TabHomeAccess" getVisible="GetVisibleDefaultTab"/>
<tab idMso="TabPrintPreviewAccess" getVisible="GetVisibleDefaultTab"/>
<tab idMso="TabCreate" getVisible="GetVisibleDefaultTab"/>
<tab idMso="TabDatabaseTools" getVisible="GetVisibleDefaultTab"/>
<tab idMso="TabExternalData" getVisible="GetVisibleDefaultTab"/>' belongs to RibbonCustomizations
Sub GetVisibleDefaultTab(control As IRibbonControl, ByRef visible)
' for now limit to controls starting with tab
If Left(control.ID, 3) <> "Tab" Then
visible = True
Exit Sub
End If
Select Case control.ID
Case "TabHomeAccess"
visible = hasRole(True, True, True, True, True, True)
Case "TabPrintPreviewAccess"
visible = hasRole(True, True, True, True, True, True)
Case "TabCreate"
visible = hasRole(False, False, False, False, False, True)
Case "TabDatabaseTools"
visible = hasRole(False, False, False, False, False, True)
Case "tabFrontendMaintenance"
visible = hasRole(False, False, False, False, False, True)
Case Else
visible = False
End Select
End SubHistorically 3 frontend (Analyse, Admin, Data Entry) existed under DHAMIS. They were targeted to different groups of users. While these frontends had different release cycles, they also shared a lot of implementation details (mostly queries and VBA code). Merging them into one frontend should make usage and maintenance easier.
This is a new activity not in initial Scoping estimation.
Merging all Access objects from the different frontends will make the navigation for developing purposes harder (simply because there are more Access objects to can 'clutter' up the Navigation Pane). With the default Access Navigation Pane all Object types across the previous Frontends are shown together. Custom Groups and Categories in the Navigation Pane can be used ease this. Every Access object can be tagged with one or more Groups (and therefore fall under the associated Category). The manual association of categories and groups through the user interface is tedious and time-consuming.
However the automatic default grouping by Object Types (Tables, Queries, Forms, ...) is not available for Custom Categories. Prior to the merge for every frontend the included Access objects were identified and their names exported into a dedicated table internal_frontend_components. The VBA module MaintenanceFrontend contains code create Custom Categories Admin, DataEntry and Analyse, loops through this table and sorts the entries into the frontend categories and establishes the default groups per Access Object Type.
Additional custom grouping could be added to the table internal_frontend_components and they will automatically be re-applied.
Re-linking tables when switching backends will remove table associations. So they would need to be recreated after every relink.
All VBA code resides in FrontendMaintenance.vba.
Dev note to prepare content for initial population of internal_frontend_components
SELECT name,type,
switch(
type = 1, "Table",
type = 2, "Database",
type = 3, "Container",
type = 4, "Linked ODBC Table",
type = 5, "Query",
type = 6, "Linked Access Table",
type = 8, "Sub datasheet",
type = -32768, "Form",
type = -32766, "Macro",
type = -32764, "Report",
type = -32761, "Module",
type = -32758, "User",
type = -32757, "Database Document",
true, "something else")
from MSysobjects
all these need additional verification
Object name type type as text Expr1003
art_accom -32768 Form 2
art_clinic 5 Query 2
art_clinic_obs_drug_stocks 5 Query 2
art_clinic_year_quarter 5 Query 2
art_coh_reg_target_maxdate 5 Query 2
art_cohort_reg_target_5a 5 Query 2
art_person -32768 Form 2
art_person_data 5 Query 3
art_person_deduplicate 5 Query 2
art_reg_cum_now_valid 5 Query 2
art_reg_cum_outc_valid 5 Query 2
art_reg5A_data 5 Query 2
art_reg5A_data_ANC_mat 5 Query 2
art_reg5A_data_ART 5 Query 2
art_sched_append -32766 Macro 2
art_sched_chk_all 5 Query 2
art_sched_chk_cancelled 5 Query 2
art_sched_chk_dup 5 Query 2
art_sched_chk_duplicates 5 Query 2
art_sched_chk_missed 5 Query 2
art_sched_chk_union 5 Query 2
art_sched_date 5 Query 2
art_sched_person subreport -32764 Report 2
art_sched_report 5 Query 2
art_sched_set_app 5 Query 2
art_sched_set_del 5 Query 2
art_sched_set_rank 5 Query 2
art_sched_set_rank_select 5 Query 2
art_sched_set_select 5 Query 2
art_schedule -32768 Form 2
art_schedule -32764 Report 2
art_schedule_date_range 5 Query 2
art_schedule_date_range_rank_mktbl 5 Query 2
art_target_reg5_int 5 Query 2
art_target_reg5_int_min 5 Query 2
art_target_reg5_quart 5 Query 2
art_target_reg5_quart_cum 5 Query 2
art_target_reg5_quart_cum_sum 5 Query 2
calc_test 5 Query 2
calc_test_result 5 Query 2
chksum_qry_right 5 Query 2
code_hdepartment_tb_bmu 5 Query 2
concept_set_ctl_type 5 Query 2
concept_set_data 5 Query 2
current_user 5 Query 2
data_entry_stats -32764 Report 2
data_entry_stats_page2 5 Query 2
data_entry_stats_page3 5 Query 2
data_entry_stats_union 5 Query 2
data_entry_stats_union_group 5 Query 2
hdepartment_name 5 Query 2
map_psm_ro_item_set_clear 5 Query 2
map_psm_ro_item_set_fill 5 Query 2
map_psm_ro_item_set_ID 5 Query 2
obs_dim_set 5 Query 2
obs_dim_set_tmptbl_app 5 Query 2
obs_dim_set_tmptbl_clear 5 Query 2
obs_set_tmptbl_app 5 Query 2
obs_set_tmptbl_clear 5 Query 2
psm_dist_batch -32768 Form 2
psm_dist_item_check_frm -32768 Form 2
psm_dist_round -32768 Form 2
psm_DL_chk_deviate -32764 Report 2
psm_DL_chk_deviate 5 Query 2
psm_DL_chk_missing -32764 Report 2
psm_DL_chk_missing 5 Query 2
psm_DL_item -32768 Form 2
psm_DL_item_frmdata 5 Query 2
psm_DL_sheet -32768 Form 2
psm_DL_sheet_frmdata 5 Query 2
psm_relocate -32768 Form 2
psm_relocate_quarter_stopdate 5 Query 2
psm_relocate_report 5 Query 2
psm_ro_item_set -32768 Form 2
psm_ro_item_set 5 Query 2
psm_ro_sheet -32768 Form 2
psm_stock_report_balance -32768 Form 2
PubFunctions -32761 Module 2
ReapplyFieldProperties -32761 Module 3
RelinkTables -32761 Module 3
subfrm_art_sched_day -32768 Form 2
subfrm_art_sched_day_accom -32768 Form 2
subfrm_art_sched_person -32768 Form 2
subfrm_art_sched_site -32768 Form 2
subfrm_psm_dist_item_sum -32768 Form 2
supply_item_label 5 Query 3
supply_item_set_data 5 Query 3
supply_item_set_label 5 Query 3
supply_item_set_version 5 Query 3
supply_item_set_version_art_drug_stocks 5 Query 2
Switchboard -32768 Form 3
Switchboard Backend Selector -32768 Form 3
version -32768 Form 3
version_max 5 Query 3
Based on the internal_frontend_components table which contains all access objects from all frontends, additional analysis is possible to spot duplicates across frontends
select [Object name], type, [type as text], count(*) from internal_frontend_components
WHERE type NOT in (1, 4, 6)
group by [Object name], type, [type as text]
having count(*) > 1
These duplicates were then further assessed (by automatic comparison) to identify Access objects with same names, but different implementations.
To be completed: Objects named ...1 and ...2
The Data Entry frontend contained local copies of the tables concept and concept_set for optimization purposes. These tables are populated at startup. As this caching takes a bit of time and is only needed for data entry, this shouldn't be done in the unified frontend in the same way. Instead now these local tables are updated whenever a new data entry happens.
VBA code
Add to AutoExec
Private Sub Form_Close()
On Error Resume Next
Call updateInternalAuditTrail("unified", CurrentFrontendVersionID(), "close")
On Error GoTo 0
End Sub
Private Sub Form_Open(Cancel As Integer)
If Get_locale_country <> 44 Then
MsgBox "Region Settings of your computer are not set to United Kingdom (UK). Please see the IT administration. Exiting now."
DoCmd.Quit
End If
On Error Resume Next
Call updateInternalAuditTrail("unified", CurrentFrontendVersionID(), "open")
On Error GoTo 0
End Sub
Change end of on_Timer of AutoExec to
' now open Homepage if all good
DoCmd.OpenForm "Homepage"
' DoCmd.Close acForm, "AutoExec"
Forms![AutoExec].visible = False
Forms maintenance_custom_groups*
Compacting reopens current DB (and as default not in Design (shift) mode)
Afterwards the Backstage Office menu isn't available anymore to save and create a MDE
The automatic compact (via undocumented SysCmd call) silently fails if the DB isn't compiling.
Form maintenance_release
New SQL passthrough modify_sql_permissions query without returning results
ReapplyPermissions.vba
Option Compare Database
Option Explicit
Sub main_reapply_permissions()
Dim rs As Recordset
Dim table As String
Dim readonly As String
Dim User As String
Dim data_entry As String
Dim care_and_treatment As String
Dim logistics As String
Dim program_officer As String
Dim admin As String
Dim typ As String
Set rs = CurrentDb.OpenRecordset("internal_permissions", dbOpenDynaset, dbSeeChanges)
'populate the table
rs.MoveLast
rs.MoveFirst
Do While Not rs.EOF
table = rs!table
readonly = rs!role_dha_readonly
User = rs!role_dha_user
data_entry = rs!role_dha_data_entry
program_officer = rs!role_dha_program_officer
care_and_treatment = rs!role_dha_care_and_treatment
logistics = rs!role_dha_logistics
admin = rs!role_dha_admin
' revoke permissions for dha_user and _readonly, ignore _admin for now (unsure if we could lock ourselves out)
'Call revokePermissions(table, "dha_user")
'Call revokePermissions(table, "dha_readonly")
'Call revokePermissions(table, "dha_program_officer")
Call revokePermissions(table, "dha_data_entry")
'Call revokePermissions(table, "dha_logistics")
'Call revokePermissions(table, "dha_care_and_treatment")
Call revokePermissions(table, "dha_admin")
' apply new permissions
'Call grantPermissions(table, "dha_user", user)
Call grantPermissions(table, "dha_data_entry", data_entry)
'Call grantPermissions(table, "dha_program_officer", program_officer)
'Call grantPermissions(table, "dha_care_and_treatment", care_and_treatment)
'Call grantPermissions(table, "dha_logistics", logistics)
'Call grantPermissions(table, "dha_readonly", readonly)
Call grantPermissions(table, "dha_admin", admin)
rs.MoveNext
Loop
End Sub
Private Sub revokePermissions(table As String, role As String)
Dim p As String
p = "REVOKE SELECT, INSERT, UPDATE, DELETE ON " & table & " FROM " & role & ";"
Debug.Print p
modifySqlPermissions (p)
End Sub
Private Sub grantPermissions(table As String, role As String, permissions As String)
Dim p As String
If permissions = "noaccess" Then
Exit Sub
ElseIf permissions = "read" Then
p = "SELECT"
ElseIf permissions = "write" Then
p = "SELECT, INSERT, UPDATE, DELETE"
End If
p = "GRANT " & p & " ON " & table & " TO " & role & ";"
Debug.Print p
modifySqlPermissions (p)
End Sub
Sub modifySqlPermissions(sql As String)
Dim qdf As DAO.QueryDef
Set qdf = CurrentDb.QueryDefs("modify_sql_permissions")
qdf.sql = sql
qdf.Execute
End Sub
Query Builder: enable multi quarter selection for Cumulative Export Start date of dist round Retrospectively set new/final date for start of dist round change date when a delivery note is scanned with an earlier date than the tentative dist round start date add physical stock count day from warehouse
No need anymore to use Macros just to invoke Queries (if the readonly datasheet view is needed)
Exit DB if not set to UK country settings.
A key/value table to store configs (and other constants) like
- path to LocalDB database files
- MSQL server + instance for LocalDB and Live
- timestamp set by a job through scheduler to indicate a most recent point in time when the DB was taken from the server
Table internal_config (ID, Key, Value, Description) created
maybe by a schedule job updating a field in internal_config (to be created) every hour or so. this way a local offline copy would (roughly) know from when its baseline is
Create scheduled job 'Update Database Timestamp Field' to update an entry within table internal_config every hour. This way the database files themselves contain the information from when it is and can be displayed especially in the offline scenario.
delete from internal_config where [key] = 'database.timestamp';
INSERT INTO [dbo].[internal_config]([Key],[Value],[Description])
VALUES ('database.timestamp' ,getdate(),'Timestamp of scheduled job marking the DB to be used as Database age for Offline setup');
PubFunctions.IsLiveDatabasd
IsLiveDatabase = InStr(t.Connect, "NDX-HAD1\DHA_MIS")
Form_Switchboard: Add 2 Labels below ItemText (with blue text color and underlined) named lblPath1 and lblPath2
Private Sub lblPath1_Click()
Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=1"
End Sub
Private Sub lblPath2_Click()
Me.Filter = "[ItemNumber] = 0 AND [SwitchboardID]=3"
End Sub
Private Function switchboardHierarchyLevel(sbId As Integer)
Select Case sbId
Case 1
switchboardHierarchyLevel = 0
Case 8
switchboardHierarchyLevel = 2
Case Else
switchboardHierarchyLevel = 1
End Select
End Function
Append to FillOptions()
Case 0
Me.lblPath1.Caption = ""
Me.lblPath2.Caption = ""
Case 1
Me.lblPath1.Caption = "Main"
Me.lblPath2.Caption = ""
Case 2
Me.lblPath1.Caption = "Main"
Me.lblPath2.Caption = "Tables"
End Select
Form_Switchboard
Public Sub RefreshConnectionDetails()
Call updateConnectionDetails
Me.DbUser = CurrentDbUser()
Me.DhaUser.value = CurrentUser()
Me.ServerName.value = CurrentServer()
Me.DbInstance.value = CurrentDbInstance()
Me.DbTrustedConnection = CurrentDbTrustedConnection()
End Sub
Private Sub UpdateLinkedTables_Click()
DoCmd.OpenForm "Switchboard Backend Selector"
End Sub
Form_Switchboard Backend selector
Private Sub Command1_Click()
If IsNull(Text3) Then
RelinkTables.main_RelinkAllTables Combo0.value, Combo2.value
Else
RelinkTables.main_RelinkAllTables Combo0.value, Combo2.value, Text3.value, Text5.value
End If
Call Form_Switchboard.RefreshConnectionDetails
MsgBox "Backend DB changed"
DoCmd.Close acForm, Me.name
End Sub
avoid selecting multiple quarters when choosing cumulative. Disabling multiselect propery of listbox during runtime isn't possible (only in Design mode). Simply deselect multi values whenever in Cumulative period is a workaround
Change text of label30 (Select one or several Periods) to Select one or several Periods (only one Quarter for Cumulative)
Form_report_qrybuild
Private Sub select_period_AfterUpdate()
Call simulateSingleSelectForSelectYearQuarter
End Sub
Private Sub simulateSingleSelectForSelectYearQuarter()
' make sure only one quarter is selected when using cumulative period
' Me.select_year_quarter.MultiSelect can not be changed through code, only (staticly) in form desgn mode
Dim counter As Integer
If Me.select_period.Selected(1) = True Then
' cumulative selected
If Me.select_year_quarter.ItemsSelected.Count > 1 Then
For counter = Me.select_year_quarter.ItemsSelected.Count To 2 Step -1
' loop backwards to deselect all except first quarter in list
Me.select_year_quarter.Selected(select_year_quarter.ItemsSelected.item(counter - 1)) = False
Next counter
End If
End If
End Sub
Private Sub select_year_quarter_AfterUpdate()
Call simulateSingleSelectForSelectYearQuarter
End Sub
Add to Form.Load of FormSwitchboard and
Dim heightOffsetOption1 As Integer
Dim distanceBetweenOptions As Integer
' capture height offset for later rearrange to dynamically add scrollbars
heightOffsetOption1 = Me("Option1").Top
distanceBetweenOptions = Me("Option2").Top - Me("Option1").Top
Private Sub FillOptions()
' Fill in the options for this switchboard page.
' The number of buttons on the form.
Const conNumButtons = 16
Dim con As Object
Dim rs As Object
Dim stSql As String
Dim intOption As Integer
' Set the focus to the first button on the form,
' and then hide all of the buttons on the form
' but the first. You can't hide the field with the focus.
Me![Option1].SetFocus
For intOption = 2 To conNumButtons
Me("Option" & intOption).Visible = False
Me("OptionLabel" & intOption).Visible = False
Me("Option" & intOption).Top = heightOffsetOption1
Me("OptionLabel" & intOption).Top = heightOffsetOption1
Next intOption
' Open the table of Switchboard Items, and find
' the first item for this Switchboard Page.
Set con = Application.CurrentProject.Connection
stSql = "SELECT * FROM [Switchboard Items]"
stSql = stSql & " WHERE [ItemNumber] > 0 AND [SwitchboardID]=" & Me![SwitchboardID]
stSql = stSql & " ORDER BY [ItemNumber];"
Set rs = CreateObject("ADODB.Recordset")
rs.Open stSql, con, 1 ' 1 = adOpenKeyset
' If there are no options for this Switchboard Page,
' display a message. Otherwise, fill the page with the items.
If (rs.EOF) Then
Me![OptionLabel1].Caption = "There are no items for this switchboard page"
Else
Dim i As Integer
Dim offset As Integer
offset = 1502 ' where 1st switchboad entry starts
i = 0
While (Not (rs.EOF))
Me("Option" & rs![ItemNumber]).Visible = True
Me("OptionLabel" & rs![ItemNumber]).Visible = True
Me("OptionLabel" & rs![ItemNumber]).Caption = rs![ItemText]
Me("Option" & rs![ItemNumber]).Top = heightOffsetOption1 + i * distanceBetweenOptions
Me("OptionLabel" & rs![ItemNumber]).Top = heightOffsetOption1 + i * distanceBetweenOptions
rs.MoveNext
i = i + 1
Wend
' just to invoke a resize which then fits according to visible controls
Me.Detail.Height = 2000
End If
' Close the recordset and the database.
rs.Close
Set rs = Nothing
Set con = Nothing
End Sub
Pressing ESC to return to previous level (except Main switchboard); hitting keys 1 - 9 for quick invocation of Switchboard items
Add to Form_Switchboard.Form_load Me.KeyPreview = True
Private Sub Form_KeyPress(KeyAscii As Integer)
Dim Rs As Recordset
If KeyAscii = vbKeyEscape Then
' return to higher level with ESC
If SwitchboardID > 1 Then
' not main switchboard, so ESC should work
Set Rs = CurrentDb.OpenRecordset("select * from [switchboard items] where switchboardid=" & SwitchboardID & " order by itemnumber desc", dbOpenDynaset, dbSeeChanges)
If Not Rs.EOF Then
Call HandleButtonClick(Rs!ItemNumber)
End If
End If
'DoCmd.Close acForm, Me.name, False
ElseIf KeyAscii > 48 And KeyAscii < 58 Then
' respond to keys 1 to 9 (ascii codes 49 to 57), subtract 48 to go from ASCII code to number
Call HandleButtonClick(KeyAscii - 48)
End If
End Sub
RelinkTables
Private Function createOdbcConnectString(stServer As String, stDatabase As String, Optional stUsername As String, Optional stPassword As String)
'ODBC;DRIVER=ODBC Driver 11 for SQL Server;SERVER=IE11WIN7\SQLEXPRESS;Trusted_Connection=Yes;APP=Microsoft® Windows® Operating System;DATABASE=HIVData2;;TABLE=dbo.art_accom
If Len(stUsername) = 0 Then
'//Use trusted authentication if stUsername is not supplied.
If stServer = "(localdb)\MSSQLLocalDB" Then
createOdbcConnectString = "ODBC;DRIVER=ODBC Driver 11 for SQL Server;SERVER=" & stServer & ";Trusted_Connection=Yes;DATABASE=" & stDatabase & ";AttachDbFilename=c:\HIVData-live.mdf;"
Else
createOdbcConnectString = "ODBC;DRIVER=ODBC Driver 11 for SQL Server;SERVER=" & stServer & ";Trusted_Connection=Yes;DATABASE=" & stDatabase & ";;"
End If
Else
'//WARNING: This will save the username and the password with the linked table information.
createOdbcConnectString = "ODBC;DRIVER=ODBC Driver 11 for SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";UID=" & stUsername & ";PWD=" & stPassword
End If
End Function
Between live & local offline
- readonly
- data entry (former DHA User)
- logistics (former DHA User)
- program officers (former DHA User) (mostly readonly)
- care & treatment (former DHA User)
- admin
Currently these are 2 separate buttons, but they could be merged into one 'toggle' button.
CREATE TABLE [dbo].[internal_app_trail](
[ID] [int] IDENTITY(1,1) NOT NULL,
[Frontend] [nvarchar](7) NOT NULL,
[FrontendVersionID] [int] NOT NULL,
[SwitchboardID] [int] NOT NULL,
[Item] [int] NOT NULL,
[User] [nvarchar](6) NOT NULL,
[OpenedAt] [datetime] NOT NULL
) ON [PRIMARY]
GO
...
Call updateInternalAuditTrail("analyse", Me!SwitchboardID, intBtn)
...
Sub updateInternalAuditTrail(frontend As String, SwitchboardID As Integer, intBtn As Integer)
Dim sql As String
sql = "INSERT INTO [dbo].[internal_app_trail] ([Frontend],[SwitchboardID],[Item],[User],[OpenedAt]) " & _
"VALUES ('" & frontend & "'," & SwitchboardID & "," & intBtn & ",'" & CurrentUser() & "',getdate())"
Debug.Print sql
Debug.Print sql
End Sub
SQL Passthrough Query insert_into_internal_app_trail with property 'Returns Records' = No INSERT INTO [dbo].[internal_app_trail] ([Frontend],[SwitchboardID],[Item],[User],[OpenedAt]) VALUES ('analyse',1,1,'chrneu',getdate())
plus 'öbbes' un documented