How do I compile?

[OhioSteve]

I want to compile an .mdb. How do I do that?

 

[ThomasLafferty]

Open the module of a form or open an existing module from your object pane of the database window. From your menubar, select Debug>Compile.

Incidentally, if you need to decompile your db at some point, you can do this by clicking Start>Run. Browse to your db. This will put the full name and path in quotes. At the end of the name and path, press the space bar and type \decompile, hold down your shift key to prevent running of any startup code (assuming you have not disabled special keys) and click OK.

Hope this helps.

Tom

Born once die twice; born twice die once.

 

[OhioSteve]

I did it but it did not make much of a difference. Access still opens when I open the file, I can still create a new table in the file, etc.

 

[randy700]

You may be thinking of making an .mde file. To do so, go to Tools > Database Utilities > Make MDE File...

Make a backup copy first!

This will prevent anyone, including you, from doing anything with the tables, queries, design, etc.


Randy

 

[ItIsHardToProgram]

I think that what you are searching for is turning your database in *.exe, Maybe I am wrong... but that is impossible to do with access, since access is a program that uses specific functions to run the database, it can't be compiled into a file that could be open by any user, that would mean that your frontend would be gigantic to have all these functions. Maybe I am wrong, I haven't read any documentation on this, but I think it is logical...

I am sure that other software would do this... professional software of course, that are costy.

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[ItIsHardToProgram]

randy700 can you make a MDE with only your front end?

And can that MDE be open without access?

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[randy700]

I haven't converted one in quite some time, but as I recall...
You can convert just the front end.
You need Access on your machine to open the mde file.


Randy

 

[ItIsHardToProgram]

As I thought, Thank you randy.

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[OhioSteve]

Okay, I did a bit of research on .mde files and some testing. It does stop the user from messing up my forms and modules. But it does NOT stop them from changing tables or queries.

 

[ItIsHardToProgram]

OhioSteve,
it will stop them to change any STRUCTURAL modification I believe, stopping a user from changing a table or querry would mean stopping him from modifying your data, which can be done via code (acreadonly) I don't quite understand what you want... please be more specific. Mesing up forms and modules and change table or queries does not tell me enough....

Thanks

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[OhioSteve]

Thanks for posting again. I am distributing an Access DB to laptop users. Here are my needs:

1. The DB must interact with other network resources, that means putting connection information into the DB. If a laptop was stolen, I do not want the thief to have those connection strings.

2. Users sometimes get curious about applications and try to "improve" them. I want to STOP that from happening.

3. The normal Access security system, with workgroup information files, has some shortcommings. I have atttempted to use it before, and I found it very confusing. Also I have heard that it is easy to defeat. Finally, if I use it then my users will need to remember yet another password. So I want to avoid using it if possible.

I have partly developed a strategy for meeting my needs:

A. I can use your tips and compile to an .mde. That completely fixes problem 1, assuming that the connection strings are in my modules and not in a table. The modules will be compiled. So the thief will not be able to read the connection strings. Compiling to an .mde also helps with issue #2, because curious users can't change my forms.

B. I have partly fixed problem #2. I have created a startup form, custom toolbar, etc. Then I found a vba function that totally disables shift-bypass. That's really cool!

Unfortunately the users could still mess up the table structure, even if I compile it. They can still drop fields from a table, for example. So that is really my sole remaining problem: How do I stop them from changing my table structure?

 

[ItIsHardToProgram]

OhioSteve

Then I found a vba function that totally disables shift-bypass. That's really cool!

Great, maybe you want to share this?

I am not very comfortable in access security... File protection is something I am more familiar with... encryption... but with access designed protection for tables I am not... I know that there is a function in access that stops users (access protection which you don't seem to want) from modifying those tables/query structure...

I am glad that you got to fix most of your problems... but stopping users from changing table structure without using access seems to be harder then I thought...

I can't really think of something... how would the user go to drop a field??? simply open the table? from the startup menu? Are your forms passing through querys that disables that function? are you reading directly from tables sometimes??? Maybe that would be your problem... Then again maybe I am sitting in a forest surrounded by huge oaks....

Sorry I could not be of further assistance.. I am mostly learning myself and am enjoying my tek-tips experience, more then every one reading my I think Being french does not help me

Hope my thoughts help you a bit still.

Julien

"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[JerryKlmns]

ItIsHardToProgram

OhioSteve

Quote:
Then I found a vba function that totally disables shift-bypass. That's really cool!

Great, maybe you want to share this?

Create those properties first (available only through VBA)

Sub Initiation()

Dim dbs As Object
Dim prp As Object
Dim AllowBypassKey As Boolean
Dim AllowBreakIntoCode As Boolean

    Set dbs = Application.CurrentDb
    Set prp = dbs.CreateProperty("AllowBypassKey", 1, True, True)
    dbs.Properties.Append prp
    Set prp = dbs.CreateProperty("AllowBreakIntoCode", 1, True, True)
    dbs.Properties.Append prp
    With dbs
        .Properties("AppTitle") = "Initiation Of All Properties"
        .Properties("StartupForm") = "StartUp"
        .Properties("AllowFullMenus") = True
        .Properties("AllowShortcutMenus") = True
        .Properties("StartupShowDBWindow") = True
        .Properties("StartupShowStatusBar") = True
        .Properties("AllowBuiltInToolbars") = True
        .Properties("AllowToolbarChanges") = True
        .Properties("AllowSpecialKeys") = True
        .Properties("AllowBypassKey") = True
        .Properties("AllowBreakIntoCode") = True
        Application.RefreshTitleBar
        .Close
    End With
    Set prp = Nothing
    Set dbs = Nothing

End Sub

And control those properties

Sub EnforceDbProperties()

    Dim dbs As Object
    Dim prp As Object
    

    If Application.CurrentUser = "YourAccessUserIDHere" Then
        Set dbs = Application.CurrentDb
        With dbs
        If .Properties("AllowByPassKey") = True Then
            .Properties("AppTitle") = "myUgglyCompanyName"
            Set prp = dbs.CreateProperty("StartupForm", 10, "StartUp", True)
            .Properties.Append prp
            Set prp = Nothing
            .Properties("AllowFullMenus") = False
            .Properties("AllowShortcutMenus") = True
            .Properties("StartupShowDBWindow") = False
            .Properties("StartupShowStatusBar") = True
            .Properties("AllowBuiltInToolbars") = True
            .Properties("AllowToolbarChanges") = False
            .Properties("AllowSpecialKeys") = False
            .Properties("AllowBypassKey") = False
            .Properties("AllowBreakIntoCode") = True
            Application.RefreshTitleBar
        Else
            .Properties("AppTitle") = "Hello Master"
            .Properties.Delete "StartUpForm"
            .Properties("AllowFullMenus") = True
            .Properties("AllowShortcutMenus") = True
            .Properties("StartupShowDBWindow") = True
            .Properties("StartupShowStatusBar") = True
            .Properties("AllowBuiltInToolbars") = True
            .Properties("AllowToolbarChanges") = True
            .Properties("AllowSpecialKeys") = True
            .Properties("AllowBypassKey") = True
            .Properties("AllowBreakIntoCode") = True
            Application.RefreshTitleBar
        End If
        .Close
        End With
    End If
    
    Set dbs = Nothing

End Sub

call that sub at the press of the close database button.
It just has to be you and been using Access2000 or above.

-----------------
OhioSteve

I think the only way to prevent users from modifying your objects' structure is only through user-level security. Even if you apply a simple database password (crackable) and interact with your mdb only through forms, an ADOX-knowing user or a DAO-knowing user could still make amendments (or set to fire).

 

[ItIsHardToProgram]

Thank you jerryKlmns,

I guess that is why access is only for educational puposes =/


"Knowing that you know is the greatest sign of stupidity, knowing that you are ignorant is the best proof of intelligence.

 

[hwkranger]

I do this all the time -- with my applications.

1) Don't use Linked tables in your FE Database
2) Don't have any Queries in your FE Database
3) User ADO Recordsets and Connections to retrieve your data
4) Create an MDE

Treat access like you're using VB 6 or VB.NET. Write in all code, use unbound forms -- and everything is fine. If you want I can send you copy of an application that I've made that is driven from a MDB on a network drive, with an MDE that's located on the local machine.

The connection string that is built uses the \\networkname mapping, so that as long as the person is on the network and have group access to the drive, then the data is available through the connection.

here's a snippet of how I handle my projects:


GLOBALS

Public Const DEFAULT_LOCKED_BACK_COLOR = 15790316 'Greyish blue
Public Const DEFAULT_UNLOCKED_BACK_COLOR = 16777215 'White

Public Const PITMAINK_DRIVE = "\\Pit-maink1\Vol1\SHARED.COL\DATA\LSHARED\"
Public Const PITDEPT2_DRIVE = "\\Pit-dept02\Vol1\SHARED.ALT\DATA\LSHARED\"
Public Const BACKEND_LOCATION = "\\Pit-maink1\Vol1\SHARED.COL\DATA\LSHARED\DataCenter\Application\HLS_DATA_CENTER.mdb"
Public Const DRAFT_BE_LOCATION = "\\Pit-dept02\Vol1\SHARED.ALT\DATA\LSHARED\SIMS MASTER\DFT4.mdb"
Public Const DIALER_BE_LOCATION = "\\Pit-maink1\Vol1\SHARED.COL\DATA\LSHARED\DIALER TRANSFER\DIALER DATABASE.mdb"
Public Const SPEEDPAY_LOCATION = "\\Pit-maink1\Vol1\SHARED.COL\DATA\LSHARED\DataCenter\Databases\Speed_Pay.mdb"
Public Const COLLECTION_LOCATION = "\\Pit-maink1\Vol1\SHARED.COL\DATA\LSHARED\Collections\collections_data.mdb"

'Standard user Groups not all
Public Enum USER_GROUP
    g_GROUP_DEFAULT = 1
    g_GROUP_ADMIN = 2
End Enum

'Standard User levels, not all
Public Enum USER_LEVEL
    g_ADMIN_USER = 99
End Enum

Public gobjNCCApp As New clsApplication

Public dbcnn As New ADODB.Connection 'Back end connection
Public DaisyCnn As New ADODB.Connection  'ADO connection to DAISY

Public Collectioncnn As New ADODB.Connection 'COLLECTIONS\Collections_Data.mdb connection
Public Draftcnn As New ADODB.Connection 'SIMS MASTER\DFT4.mdb connection
Public Dialercnn As New ADODB.Connection   'DIALER TRANSFER\DIALER DATABASE.mdb connection

ON START UP

Public Function Startup()
    
    'Set all the connection strings
    Set dbcnn = New ADODB.Connection
    dbcnn.ConnectionString = ReturnBEConnectionString
    dbcnn.Open
    gobjNCCApp.Init
    'Set dbcnn = CurrentProject.Connection
    
    Set Draftcnn = New ADODB.Connection
    Draftcnn.ConnectionString = ReturnAccessConnectionString(DRAFT_BE_LOCATION)
    Draftcnn.Open
    
    Set Dialercnn = New ADODB.Connection
    Dialercnn.ConnectionString = ReturnAccessConnectionString(DIALER_BE_LOCATION)
    Dialercnn.Open
    
    Set Collectioncnn = New ADODB.Connection
    Collectioncnn.ConnectionString = ReturnAccessConnectionString(COLLECTION_LOCATION)
    Collectioncnn.Open
    
    '** NOT CURRENTLY USED **
    'Set DaisyCnn = New ADODB.Connection
    '** END OF DAISY NOT CURRENTLY USED **
    
    Call LogUserLogIn
    ReLoadMainMenu
    If Not isVersionCurrent Then
        MsgBox ("You do not have a current version.  Please request assistance.")
        DoCmd.Quit
    End If
End Function

Public Function ReturnBEConnectionString() As String
'THIS NEEDS TO BE CHANGED WHEN THE APPLICATION MIGRATES TO A DIFFERENT BACKEND SERVICE
    'Dim strCN As String
    'strCN = strCN & "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;"
    'strCN = strCN & "Data Source=" & BACKEND_LOCATION & ";"
    ReturnBEConnectionString = ReturnAccessConnectionString(BACKEND_LOCATION)
End Function

Public Function ReturnAccessConnectionString(strSourceLocation As String) As String
    Dim strCN As String
    strCN = strCN & "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;"
    strCN = strCN & "Data Source=" & strSourceLocation & ";"
    ReturnAccessConnectionString = strCN
End Function

ENCAPSULATION USEAGE IN A CLASS MODULE

Option Compare Database
Option Explicit
'*******************************************************
'*                   AUTOGENERATED CODE FOR                                *
'*                       tblUser CLASS
'*
'*                 BUILDER BY RANDALL VOLLEN                               *
'******************7/7/2006 9:13:30 AM***********************


'*************** BUISINESS DATA TYPE **********************'


Private Type biztblUser_TYPE
    mstrXID As String
    mstrDisplay_Name As String
    mstrFNAME As String
    mstrLNAME As String
    mstrEMAIL As String
    mstrWXP_Machine As String
    mstrIP_Address As String
    mlngLogCount As Long
    mstrLastLogIn As String
    mstrFirstLogIn As String
    mintUserLevel As Integer
    mstrPhone As String
    mblnRecievesProjects As Boolean
    mblnApprovesProjects As Boolean
End Type


Private Type biztblUser_STATE_TYPE
    XID As Boolean
    Display_Name As Boolean
    FNAME As Boolean
    LNAME As Boolean
    EMAIL As Boolean
    WXP_Machine As Boolean
    IP_Address As Boolean
    LogCount As Boolean
    LastLogIn As Boolean
    FirstLogIn As Boolean
End Type


Private Const CLASS_NAME = "tblUser"
Private Const DATA_ACCESS = "tblUser"
Private adtbiztblUser_DATA As biztblUser_TYPE
Private adtbiztblUserBefore_DATA As biztblUser_TYPE
Private adtbiztblUser_STATE_DATA As biztblUser_STATE_TYPE
Private cn As New ADODB.Connection
Private blnFetched As Boolean




'*************** Let/Get Properties **********************'
'*      Change these to public if public access is required.               *


'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let XID(mstrXID As String)
    adtbiztblUser_DATA.mstrXID = mstrXID
End Property
Public Property Get XID() As String
    XID = adtbiztblUser_DATA.mstrXID
End Property
'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let Display_Name(mstrDisplay_Name As String)
    adtbiztblUser_DATA.mstrDisplay_Name = mstrDisplay_Name
End Property
Public Property Get Display_Name() As String
    Display_Name = adtbiztblUser_DATA.mstrDisplay_Name
End Property
'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let FNAME(mstrFNAME As String)
    adtbiztblUser_DATA.mstrFNAME = mstrFNAME
End Property
Public Property Get FNAME() As String
    FNAME = adtbiztblUser_DATA.mstrFNAME
End Property
'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let LNAME(mstrLNAME As String)
    adtbiztblUser_DATA.mstrLNAME = mstrLNAME
End Property
Public Property Get LNAME() As String
    LNAME = adtbiztblUser_DATA.mstrLNAME
End Property
'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let EMAIL(mstrEMAIL As String)
    adtbiztblUser_DATA.mstrEMAIL = mstrEMAIL
End Property
Public Property Get EMAIL() As String
    EMAIL = adtbiztblUser_DATA.mstrEMAIL
End Property
'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let WXP_Machine(mstrWXP_Machine As String)
    adtbiztblUser_DATA.mstrWXP_Machine = mstrWXP_Machine
End Property
Public Property Get WXP_Machine() As String
    WXP_Machine = adtbiztblUser_DATA.mstrWXP_Machine
End Property
'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let IP_Address(mstrIP_Address As String)
    adtbiztblUser_DATA.mstrIP_Address = mstrIP_Address
End Property
Public Property Get IP_Address() As String
    IP_Address = adtbiztblUser_DATA.mstrIP_Address
End Property
'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let LogCount(mlngLogCount As Long)
    adtbiztblUser_DATA.mlngLogCount = mlngLogCount
End Property
Public Property Get LogCount() As Long
    LogCount = adtbiztblUser_DATA.mlngLogCount
End Property
'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let LastLogIn(mstrLastLogIn As String)
    adtbiztblUser_DATA.mstrLastLogIn = mstrLastLogIn
End Property
Public Property Get LastLogIn() As String
    LastLogIn = adtbiztblUser_DATA.mstrLastLogIn
End Property
'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let FirstLogIn(mstrFirstLogIn As String)
    adtbiztblUser_DATA.mstrFirstLogIn = mstrFirstLogIn
End Property
Public Property Get FirstLogIn() As String
    FirstLogIn = adtbiztblUser_DATA.mstrFirstLogIn
End Property


'mintUserLevel
'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let UserLevel(intUserLevel As Integer)
    adtbiztblUser_DATA.mintUserLevel = intUserLevel
End Property
Public Property Get UserLevel() As Integer
    UserLevel = adtbiztblUser_DATA.mintUserLevel
End Property
'******************************************
'*      COMMENTS:
'*  Adds a user to the default user group
'******************************************
Public Sub AddUserToDefaultGroup()
    If Len(Me.XID) > 0 Then
        Dim objUserToGroup As New clsUserToUserGroup
        objUserToGroup.XID = Me.XID
        objUserToGroup.UserGroupID = USER_GROUP.g_GROUP_DEFAULT
        If objUserToGroup.FetchRecordset.EOF Then
            objUserToGroup.InsertRecord
        End If
    End If
End Sub

'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let RecievesProjects(mblnRecievesProjects As Boolean)
    adtbiztblUser_DATA.mblnRecievesProjects = mblnRecievesProjects
End Property
Public Property Get RecievesProjects() As Boolean
    RecievesProjects = adtbiztblUser_DATA.mblnRecievesProjects
End Property

'******************************************
'*      COMMENTS:
'*
'******************************************
Public Property Let ApprovesProjects(mblnApprovesProjects As Boolean)
    adtbiztblUser_DATA.mblnApprovesProjects = mblnApprovesProjects
End Property
Public Property Get ApprovesProjects() As Boolean
    ApprovesProjects = adtbiztblUser_DATA.mblnApprovesProjects
End Property
'******************************************
'*      COMMENTS:
'*  Loads data into the members
'******************************************
Public Sub FetchData()
    Dim rst As New ADODB.Recordset
    rst.Open GetFetchSQL, cn, adOpenKeyset, adLockReadOnly
    If Not rst.EOF Then
    If Not IsNull(rst(0)) Then
        adtbiztblUser_DATA.mstrXID = rst(0)
    End If
    If Not IsNull(rst(1)) Then
        adtbiztblUser_DATA.mstrDisplay_Name = rst(1)
    End If
    If Not IsNull(rst(2)) Then
        adtbiztblUser_DATA.mstrFNAME = rst(2)
    End If
    If Not IsNull(rst(3)) Then
        adtbiztblUser_DATA.mstrLNAME = rst(3)
    End If
    If Not IsNull(rst(4)) Then
        adtbiztblUser_DATA.mstrEMAIL = rst(4)
    End If
    If Not IsNull(rst(5)) Then
        adtbiztblUser_DATA.mstrWXP_Machine = rst(5)
    End If
    If Not IsNull(rst(6)) Then
        adtbiztblUser_DATA.mstrIP_Address = rst(6)
    End If
    If Not IsNull(rst(7)) Then
        adtbiztblUser_DATA.mlngLogCount = rst(7)
    End If
    If Not IsNull(rst(8)) Then
        adtbiztblUser_DATA.mstrLastLogIn = rst(8)
    End If
    If Not IsNull(rst(9)) Then
        adtbiztblUser_DATA.mstrFirstLogIn = rst(9)
    End If
    If Not IsNull(rst(10)) Then
        adtbiztblUser_DATA.mintUserLevel = rst(10)
    End If
    If Not IsNull(rst(11)) Then
        adtbiztblUser_DATA.mstrPhone = rst(11)
    End If
    If Not IsNull(rst(12)) Then
        adtbiztblUser_DATA.mblnRecievesProjects = rst(12)
    End If
    If Not IsNull(rst(13)) Then
        adtbiztblUser_DATA.mblnApprovesProjects = rst(13)
    End If
    adtbiztblUserBefore_DATA = adtbiztblUser_DATA
    blnFetched = True
    End If
End Sub

'******************************************
'*      COMMENTS:
'*  Inserts the data from the members into the Database
'******************************************
Public Sub InsertRecord()
    cn.Execute GetInsertSQL()
    'Insert a default group for a user
    Call AddUserToDefaultGroup
    Call Me.LogAction(30, CLASS_NAME & " Modified Item: " & adtbiztblUser_DATA.mstrXID, , , "Insert")

End Sub

'******************************************
'*      COMMENTS:
'*  Updates the Database with the data from the members
'******************************************
Public Sub UpdateRecord()
    cn.Execute GetUpdateSQL()
Call Me.LogAction(30, CLASS_NAME & " Modified Item: " & adtbiztblUser_DATA.mstrXID, , , "Update")
End Sub

'******************************************
'*      COMMENTS:
'*  Deletes a Record
'******************************************
Public Sub DeleteRecord()
    cn.Execute GetDeleteSQL()
Call Me.LogAction(30, CLASS_NAME & " Modified Item: " & adtbiztblUser_DATA.mstrXID, , , "Delete")
End Sub

'******************************************
'*      COMMENTS:
'*  Returns the current Recordset
'******************************************
Public Function FetchRecordset() As ADODB.Recordset
    Dim rst As New ADODB.Recordset
    rst.Open GetFetchSQL, cn, adOpenKeyset, adLockOptimistic
    Set FetchRecordset = rst
Call Me.LogAction(10, CLASS_NAME & " Item: " & adtbiztblUser_DATA.mstrXID, , , "Fetched Record")
End Function
'******************************************
'*      COMMENTS:
'*  Returns all the records in a recordset
'******************************************
Public Function FetchAllRecordset() As ADODB.Recordset
    Dim rst As New ADODB.Recordset
    rst.Open GetFetchAllSQL, cn, adOpenKeyset, adLockOptimistic
    Set FetchAllRecordset = rst
Call Me.LogAction(10, CLASS_NAME & "Item: " & adtbiztblUser_DATA.mstrXID, , , "Fetched All Records")
End Function

Private Function GetFetchSQL() As String
    Dim strSQL As String
    strSQL = strSQL & "Select * from " & DATA_ACCESS & vbCrLf
    strSQL = strSQL & "Where XID = " & SQLPrepWithQuote(adtbiztblUser_DATA.mstrXID) & vbCrLf
    GetFetchSQL = strSQL
End Function

Public Function FetchListBoxViewRecordset(Optional strWhere As String) As ADODB.Recordset
    Dim rst As New ADODB.Recordset
    rst.Open GetFetchListBoxViewSQL(strWhere), cn, adOpenKeyset, adLockOptimistic
    Set FetchListBoxViewRecordset = rst
Call Me.LogAction(10, CLASS_NAME & "Item: " & adtbiztblUser_DATA.mstrXID, , , "Fetched All Records")
End Function
'SELECT tblUser.XID, tblUser.Display_Name FROM tblUser;
Private Function GetFetchListBoxViewSQL(Optional strWhere As String) As String
    Dim strSQL As String
    strSQL = strSQL & "SELECT tblUser.XID, tblUser.Display_Name FROM " & DATA_ACCESS & vbCrLf
    If Len(strWhere) > 0 Then
        strSQL = strSQL & "Where " & strWhere & vbCrLf
    End If
    GetFetchListBoxViewSQL = strSQL
End Function


'*** MUST EDIT INSERT WHEN USING AUTOINCREMENT ***
'* Edit this if auto numbers are used *
'******************************************
'*      COMMENTS:
'*  Builds the Insert SQL
'******************************************
Private Function GetInsertSQL() As String
    Dim strSQL As String
    strSQL = "Insert Into " & DATA_ACCESS & "("
    strSQL = strSQL & "[XID],"
    strSQL = strSQL & "[Display_Name],"
    strSQL = strSQL & "[FNAME],"
    strSQL = strSQL & "[LNAME],"
    strSQL = strSQL & "[EMAIL],"
    strSQL = strSQL & "[WXP_Machine],"
    strSQL = strSQL & "[IP_Address],"
    strSQL = strSQL & "[LogCount],"
    strSQL = strSQL & "[LastLogIn],"
    strSQL = strSQL & "[FirstLogIn],"
    strSQL = strSQL & "[UserLevel],"
    strSQL = strSQL & "[Phone],"
    strSQL = strSQL & "[RecievesProjects],"
    strSQL = strSQL & "[ApprovesProjects])"
    strSQL = strSQL & "Values( "
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrXID)) & ","
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrDisplay_Name)) & ","
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrFNAME)) & ","
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrLNAME)) & ","
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrEMAIL)) & ","
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrWXP_Machine)) & ","
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrIP_Address)) & ","
    strSQL = strSQL & adtbiztblUser_DATA.mlngLogCount & ","
    If Len(Me.LastLogIn) > 0 Then
        strSQL = strSQL & SQLPrepWithPound(CStr(adtbiztblUser_DATA.mstrLastLogIn)) & ","
    Else
        strSQL = strSQL & "null, "
    End If
    
    If Len(Me.FirstLogIn) > 0 Then
        strSQL = strSQL & SQLPrepWithPound(CStr(adtbiztblUser_DATA.mstrFirstLogIn)) & ","
    Else
        strSQL = strSQL & "null, "
    End If
    
    
    strSQL = strSQL & adtbiztblUser_DATA.mintUserLevel & ","
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrPhone)) & ","
    strSQL = strSQL & (adtbiztblUser_DATA.mblnRecievesProjects) & ","
    strSQL = strSQL & (Me.ApprovesProjects)
    strSQL = strSQL & ")"
    GetInsertSQL = strSQL
End Function

'******************************************
'*      COMMENTS:
'*  Builds the update SQL
'******************************************
Private Function GetUpdateSQL() As String
    Dim strSQL As String
    strSQL = "Update " & DATA_ACCESS & " SET "
    strSQL = strSQL & "[Display_Name] = "
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrDisplay_Name)) & ", "
    strSQL = strSQL & "[FNAME] = "
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrFNAME)) & ", "
    strSQL = strSQL & "[LNAME] = "
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrLNAME)) & ", "
    strSQL = strSQL & "[EMAIL] = "
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrEMAIL)) & ", "
    strSQL = strSQL & "[WXP_Machine] = "
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrWXP_Machine)) & ", "
    strSQL = strSQL & "[IP_Address] = "
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrIP_Address)) & ", "
    strSQL = strSQL & "[LogCount] = "
    strSQL = strSQL & adtbiztblUser_DATA.mlngLogCount & ", "
    If Len(Me.LastLogIn) > 0 Then
        strSQL = strSQL & "[LastLogIn] = "
        strSQL = strSQL & SQLPrepWithPound(CStr(adtbiztblUser_DATA.mstrLastLogIn)) & ", "
    End If
    
    If Len(Me.FirstLogIn) > 0 Then
        strSQL = strSQL & "[FirstLogIn] = "
        strSQL = strSQL & SQLPrepWithPound(CStr(adtbiztblUser_DATA.mstrFirstLogIn)) & ", "
    End If
    strSQL = strSQL & "[UserLevel] = "
    strSQL = strSQL & adtbiztblUser_DATA.mintUserLevel & ", "
    strSQL = strSQL & "[Phone] = "
    strSQL = strSQL & SQLPrepWithQuote(CStr(adtbiztblUser_DATA.mstrPhone)) & ", "
    strSQL = strSQL & "[RecievesProjects] = "
    strSQL = strSQL & (adtbiztblUser_DATA.mblnRecievesProjects) & ", "
    strSQL = strSQL & "[ApprovesProjects] = "
    strSQL = strSQL & (Me.ApprovesProjects)
    strSQL = strSQL & " Where XID= " & SQLPrepWithQuote(adtbiztblUser_DATA.mstrXID)
    GetUpdateSQL = strSQL
End Function

'******************************************
'*      COMMENTS:
'*  Builds the delete SQL
'******************************************
Private Function GetDeleteSQL() As String
    Dim strSQL As String
    strSQL = strSQL & "Delete *  from " & DATA_ACCESS & vbCrLf
    strSQL = strSQL & "Where XID = " & SQLPrepWithQuote(adtbiztblUser_DATA.mstrXID) & vbCrLf
    GetDeleteSQL = strSQL
End Function

'******************************************
'*      COMMENTS:
'*  Builds the return all records SQL
'******************************************
Private Function GetFetchAllSQL() As String
    Dim strSQL As String
    strSQL = "Select * from " & DATA_ACCESS
        GetFetchAllSQL = strSQL
End Function

Private Sub Class_Initialize()
    Set cn = dbcnn
End Sub

Private Sub Class_Terminate()
    Set cn = Nothing
End Sub


'******************************************
'*      COMMENTS:
'*  Returns True if Dirty (Data has changed), False if not
'******************************************
Public Function Dirty() As Boolean
    If adtbiztblUser_DATA.mstrXID <> adtbiztblUserBefore_DATA.mstrXID Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mstrDisplay_Name <> adtbiztblUserBefore_DATA.mstrDisplay_Name Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mstrFNAME <> adtbiztblUserBefore_DATA.mstrFNAME Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mstrLNAME <> adtbiztblUserBefore_DATA.mstrLNAME Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mstrEMAIL <> adtbiztblUserBefore_DATA.mstrEMAIL Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mstrWXP_Machine <> adtbiztblUserBefore_DATA.mstrWXP_Machine Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mstrIP_Address <> adtbiztblUserBefore_DATA.mstrIP_Address Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mlngLogCount <> adtbiztblUserBefore_DATA.mlngLogCount Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mstrLastLogIn <> adtbiztblUserBefore_DATA.mstrLastLogIn Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mstrFirstLogIn <> adtbiztblUserBefore_DATA.mstrFirstLogIn Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mintUserLevel <> adtbiztblUserBefore_DATA.mintUserLevel Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mstrPhone <> adtbiztblUserBefore_DATA.mstrPhone Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mblnRecievesProjects <> adtbiztblUserBefore_DATA.mblnRecievesProjects Then
        Dirty = True
    ElseIf adtbiztblUser_DATA.mblnApprovesProjects <> adtbiztblUserBefore_DATA.mblnApprovesProjects Then
        Dirty = True
    End If
End Function


'******************************************
'*      COMMENTS:
'*  Private Logging Function, uses the Logging class
'******************************************
Public Sub LogAction(Level As Integer, strLogText As String, Optional strErrorKey As String, Optional iStatus As Integer, Optional strAction As String, Optional strTag As String)
    Dim objLog As New clsLog
    Call objLog.FastLog(Level, strLogText, strErrorKey, iStatus, strAction, strTag)
    Set objLog = Nothing
End Sub

USE IN A FORM

Option Compare Database
Option Explicit

Private mobjUser As New clsUser
Private blnIsNew As Boolean

Public Sub LoadData(Optional strXID As String = "")
    'reset the global
    Set mobjUser = New clsUser
    'set, fetch data
    mobjUser.XID = strXID
    mobjUser.FetchData
    
    
    If Len(strXID) > 0 Then 'Data is NOT new
        blnIsNew = False
        Me.txtDisplay_Name = mobjUser.Display_Name
        Me.txtEMAIL = mobjUser.EMAIL
        Me.txtFirstLogIn = mobjUser.FirstLogIn
        Me.txtFNAME = mobjUser.FNAME
        Me.txtIP_Address = mobjUser.IP_Address
        Me.txtLastLogIn = mobjUser.LastLogIn
        Me.txtLNAME = mobjUser.LNAME
        Me.txtLogCount = mobjUser.LogCount
        Me.txtWXP_Machine = mobjUser.WXP_Machine
        Me.txtXID = mobjUser.XID
        Me.chkProject = mobjUser.RecievesProjects
        Me.chkApprovesProjects = mobjUser.ApprovesProjects
        Me.cmbUserLevel = mobjUser.UserLevel
    Else 'Data is new
        Me.txtDisplay_Name = Null
        Me.txtEMAIL = Null
        Me.txtFirstLogIn = Null
        Me.txtFNAME = Null
        Me.txtIP_Address = Null
        Me.txtLastLogIn = Null
        Me.txtLNAME = Null
        Me.txtLogCount = Null
        Me.txtWXP_Machine = Null
        Me.txtXID = Null
        Me.chkProject = Null
        Me.cmbUserLevel = Null
        Me.chkApprovesProjects = Null
        blnIsNew = True
    End If

    'load and lock the data
    Call LoadBucket
    Call LockData
    'Call LoadUserList
End Sub

Public Sub LoadUserList()
    Me.lstUser.RowSource = mobjUser.FetchListBoxViewRecordset.GetString(, , ";", ";")
End Sub

Private Sub LockData()
    'Locks the Lockable Fields
    Me.txtXID.Locked = True
    Me.txtXID.BackColor = DEFAULT_LOCKED_BACK_COLOR
    Me.txtDisplay_Name.Locked = True
    Me.txtDisplay_Name.BackColor = DEFAULT_LOCKED_BACK_COLOR
    Me.txtFNAME.Locked = True
    Me.txtFNAME.BackColor = DEFAULT_LOCKED_BACK_COLOR
    Me.txtLNAME.Locked = True
    Me.txtLNAME.BackColor = DEFAULT_LOCKED_BACK_COLOR
    Me.txtEMAIL.Locked = True
    Me.txtEMAIL.BackColor = DEFAULT_LOCKED_BACK_COLOR
End Sub

Private Sub UnlockData()
    'Unlocks the unlockable fields
    Me.txtXID.Locked = False
    Me.txtXID.BackColor = DEFAULT_UNLOCKED_BACK_COLOR
    Me.txtDisplay_Name.Locked = False
    Me.txtDisplay_Name.BackColor = DEFAULT_UNLOCKED_BACK_COLOR
    Me.txtFNAME.Locked = False
    Me.txtFNAME.BackColor = DEFAULT_UNLOCKED_BACK_COLOR
    Me.txtLNAME.Locked = False
    Me.txtLNAME.BackColor = DEFAULT_UNLOCKED_BACK_COLOR
    Me.txtEMAIL.Locked = False
    Me.txtEMAIL.BackColor = DEFAULT_UNLOCKED_BACK_COLOR
End Sub
Private Function IsDirty() As Boolean
    IsDirty = mobjUser.Dirty
End Function
Private Function IsInComplete() As Boolean
'Set completion criteria here
End Function


Public Function LoadBucket()
    Call FormatBucketColumns
    
    Dim rst As New ADODB.Recordset
    Dim objGroup As New clsUserGroup
    Set rst = objGroup.FetchAllRecordset
    'Dim objSuggestions As New clsSuggestion
    'Set rst = objSuggestions.FetchAllRecordsView
    
   Call LoadBucketItems(rst)
    
End Function

Private Function FormatBucketColumns()
'Clear the items and the headers
    lvGroups.ListItems.Clear
    lvGroups.ColumnHeaders.Clear
'clear the sort
    lvGroups.SortOrder = 0
    lvGroups.SortKey = 0
    
    Me!lvGroups.View = lvwReport
    Me!lvGroups.GridLines = True
' set the listview control to full select, which will make it act like a listbox.
    Me!lvGroups.FullRowSelect = True

'Set the Header Names
    With lvGroups.ColumnHeaders
        .Add , , "", 300
        .Add , , "Group", 1900
        .Add , , "Description", 5000
    End With
End Function

Private Function LoadBucketItems(rst As ADODB.Recordset)

    Dim LIX As MSComctlLib.ListItem
    Dim i As Integer
    Dim str_color As String
    
    Dim objUser As New clsUserToUserGroup
    objUser.FetchData
    objUser.XID = Nz(Me.txtXID, "")
    
    
    Do While Not rst.EOF
        For i = 0 To rst.Fields.count - 1
           If i = 0 Then
                Set LIX = lvGroups.ListItems.Add
                'Set the check mark based upon whether this user has access to the group
                objUser.UserGroupID = rst(0)
                LIX.Checked = Not objUser.FetchRecordset.EOF
                
                LIX.Text = rst.Fields(i).Value & ""
           Else
                    LIX.SubItems(i) = rst.Fields(i).Value & ""
           End If
        Next i
    rst.MoveNext

    Loop
End Function

Private Sub chkApprovesProjects_AfterUpdate()
    mobjUser.ApprovesProjects = Me.chkApprovesProjects
End Sub

Private Sub chkProject_AfterUpdate()
    mobjUser.RecievesProjects = Me.chkProject
End Sub

Private Sub cmbUserLevel_AfterUpdate()
    mobjUser.UserLevel = Me.cmbUserLevel
End Sub

Private Sub cmdAdd_Click()
    If IsDirty Then
        MsgBox ("Please Save the record before attempting to add a new user.")
    Else
        Call LoadData
        Call UnlockData
        Me.txtXID.SetFocus
    End If
End Sub

Private Sub cmdAddGroup_Click()
    DoCmd.OpenForm "frmUserGroup"
End Sub

Private Sub cmdClose_Click()
    If Not IsDirty Then
        DoCmd.Close acForm, Me.Name
    Else
        If Not blnIsNew Then
            mobjUser.UpdateRecord
            DoCmd.Close acForm, Me.Name
        Else
            mobjUser.InsertRecord
            DoCmd.Close acForm, Me.Name
        End If
    End If
End Sub

Private Sub cmdEdit_Click()
    UnlockData
End Sub

Private Sub cmdEditGroup_Click()
    If Not Me.lvGroups.SelectedItem Is Nothing Then
        DoCmd.OpenForm "frmUserGroup"
        Forms("frmUserGroup").LoadData (Me.lvGroups.SelectedItem.Text)
    Else
        MsgBox ("Please select a group to edit")
    End If
End Sub

Private Sub cmdSave_Click()
    If IsDirty Then
        If Not blnIsNew Then
            mobjUser.UpdateRecord
            'DoCmd.Close acForm, Me.Name
        Else
            mobjUser.InsertRecord
            'DoCmd.Close acForm, Me.Name
        End If
    End If
    
    If fIsWindowOpen("frmMainMenu") Then
        Forms("frmMainMenu").LoadMenuCombo (True)
    End If
    'Me.lstUser.Requery
    Call LoadUserList
End Sub

Private Sub Form_Open(Cancel As Integer)

    Call LoadBucket
    Call LoadUserList
    Me.lvGroups.SelectedItem = Nothing

End Sub

Private Sub lstUser_AfterUpdate()
    Call LoadData(Me.lstUser.Value)
End Sub



Private Sub lvGroups_ItemCheck(ByVal Item As Object)
If Not IsNull(Me.lstUser) Then
    Dim objUserToGroup As New clsUserToUserGroup
    objUserToGroup.XID = Nz(Me.txtXID)
    objUserToGroup.UserGroupID = Item
    If Item.Checked = False Then
        objUserToGroup.DeleteRecord
    Else
        If objUserToGroup.FetchRecordset.EOF Then
            objUserToGroup.InsertRecord
        End If
    End If
Else
    Call MsgBox("Please select a user first!", vbCritical)
End If
End Sub

Private Sub txtDisplay_Name_AfterUpdate()
    If Not IsNull(Me.txtDisplay_Name) Then
        mobjUser.Display_Name = Me.txtDisplay_Name
    Else
        mobjUser.Display_Name = ""
    End If
End Sub

Private Sub txtEMAIL_AfterUpdate()
    If Not IsNull(Me.txtEMAIL) Then
       mobjUser.EMAIL = Me.txtEMAIL
    Else
        mobjUser.EMAIL = ""
    End If
End Sub

Private Sub txtFNAME_AfterUpdate()
    If Not IsNull(Me.txtFNAME) Then
        mobjUser.FNAME = Me.txtFNAME
    Else
        mobjUser.FNAME = ""
    End If
End Sub

Private Sub txtLNAME_AfterUpdate()
    If Not IsNull(Me.txtLNAME) Then
        mobjUser.LNAME = Me.txtLNAME
    Else
        mobjUser.LNAME = ""
    End If
End Sub

Private Sub txtXID_AfterUpdate()
    If Not IsNull(Me.txtXID) Then
        mobjUser.XID = Me.txtXID
    Else
        mobjUser.XID = ""
    End If
End Sub

Since everything is managed in code -- when it's compiled into an .MDE it gives NO access to the user to mess anything up. Let them hit the shift key or hack it anyway they want... unless they are some uber hex decompiling ninja haxxor then you don't have to worry. And if they are -- chances are they are outside your scope of worries anyway...




Randall Vollen
National City Bank Corp.

 

[hwkranger]

After I posted I though to myself -- I wrote an application that generates my VBA/VB6/VB.Net code for me -- so that my model might not be useful in your situation. It would probably take you hours per form to create what I generate in a few seconds... So my solution probably wont' be very good for you!!

Randall Vollen
National City Bank Corp.