access Link to two tables, same name

Access 2010/2013:
In VBA, how do I link two tables with the same name and specify the name.
I have two databases, each with a table called 'product'.
I already have it linked, via VBA, from my frontend to one database.
How do I link also to the table in the second database and name it something like Product_new
or should I just specify "IN" on a select and also update statements.
I want to selectively copy records from product in one database to product in another database
thanks in advance.
LVL 4
Keyboard CowboyAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

grendel777Commented:
You could create a view/query in one source database and call it Product_new, then link to that instead of directly to the table.
0
Keyboard CowboyAuthor Commented:
I don't believe that would work.  I need to be able to select certain records based on long WHERE string.  The where string is driven by a form where the user indicates the records to copy to product_new.  There are at least 10 different parameters in the where string with inner joins etc.
Must be driven by VBA and flexible.  thanks for your note however.
0
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
You can just link both tables directly, in the same "master" database, without making any changes to the source databases. Access will name one of the tables "Products", and the other one "Product1" (or something like that). You can rename them after linking, and then query against them using VBA, SQL, or whatever you want.
1
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Jeffrey CoachmanMIS LiasonCommented:
If this is a one shot deal, (since you say you need to "copying" records")...you could also:
Make a copy of one of the "Products" tables, and rename it.
Import it into the other db.
Then do your "Selective Copy" (Find duplicates query, ...etc)
Then delete the imported table.


JeffCoachman
0
Keyboard CowboyAuthor Commented:
The problem, as I see it, with that approach as I need to completely automate this.  I have a dozen tables I need to copy records from and I'd like to do it based on the user filling in parameters on a form and then hitting 'copy' button.
I'm not sure how to link reliablely to product in the new database so it will have a special name  - I guess if it always links as product1 that might work.  This is not one-shot.  A user will be executing this to generate subsets of the master linked database.  To explain,
products has about 7k records with the fields field1 and field2.  I need to copy (insert) into product_new where field1 = something and field2 = something.  Field parameters are specificed by the user on a form and will change from one copy to the next.  
I'm trying to create subset copies of the database - which will include numberous lookup tables and tables used for many-to many relationships.
I tried the approach of bring up a copy of the database and just deleting what I don't want and it works but takes over an hour to run.  Looking at something faster and simpler to run when I want to extract say only 100 records - not take the approach of deleting over 7000 records (and other associated records in various tables).

So to restate, need a VBA way to connect to multiple databases with the same table name.  I guess I could depend on the 2nd table being product1 but was looking for a more reliable solution.  thanks in advance for any further ideas.
0
grendel777Commented:
Are you generating SQL code or using Access table linking? It's trivial in SQL by creating an alias for each table, though a bit cumbersome to create the dynamic SQL via VBA:

SELECT Products1.Field1, Products2.Field2
FROM SOURCE1.DATABASE1.PRODUCTS AS Products1,
SOURCE2.DATABASE2.PRODUCTS AS Products2

Open in new window


Otherwise I still think your best bet is to save a basic select query (a "view" in SQL terms) with an alias, and you can still filter it down with WHERE clauses as if it was a table.
0
Keyboard CowboyAuthor Commented:
I'm not sure the query approach would work.  The only thing I would do with the new database is insert records into it - that's the only action for product_new and a dozen other tables.
I'm not an expert in VBA or SQL so still struggling with understanding it all though I'm getting better.  I've read numerous manuals but no one seems to address this.  What I need is the insert into statement insert into product_new .... what else?
0
Jeffrey CoachmanMIS LiasonCommented:
Then I am confused...
The purpose of "Linking" is to avoid "copying" records...

What you have posted above seems to indicate that this may be more complicated than your original question indicated...
create subset copies of the database - which will include numberous lookup tables and tables used for many-to many relationships.
?

In a very broad sense, you should not need VBA to create relational data, ...*on an ongoing basis*...
I would question the design of a database system that needs to continuously "copy" records from one table to another in order to be "relational"

Perhaps I am missing something, ...so I will step aside and let you continue with the other Experts...

JeffCoachman
0
Eric ShermanAccountant/DeveloperCommented:
I'm a bit confused as well but if you want the two Product tables linked as Product and Product1 then you will have to delete Product1 before you relink them again.  Otherwise you will get Product, Product1, Product2.

ET
0
grendel777Commented:
It sounds like you have a database, I'll call it NewDB, in which you're linking to several external databases (are they all Access?). NewDB has a table that you need to populate with fields from the external sources, like column1 = source2.Name, column2 = source1.ProductID, etc. Then the user has a form where they're selecting what they want, basically filtering down the external sources, and then you need to enter the filtered value(s) into the table in NewDB. Is that right? If so, how are the users doing their filtering?
0
Keyboard CowboyAuthor Commented:
Thanks for everyone input - here's the situtation. I have a master Data database (database1) which my FE links to.  It has a table called product and a ton of other things.  I need to extract from database1 certain records and COPY to another database (database2).  Then I will ship out to a remove customer database 2.  database 2 would only contained certain records they are allowed to see (like QC'ed records, etc).  I would always maintain the master data in database1.  Database 2 and others would be read-only.  Those customers are on a different network entirely and can't reach the network that database1 is on or I would just give them some kind of access to database1.   That is not possible.  So I ship a copy of the FE and database2 for customer 2.  customer 3 would get an enitrely different set of data.  etc.  I have a dozen customers like this.  I would periodically (maybe once a quarter or once a year) ship them a new database 2 to replace the one they have.  Users (basically me) have like 5-6 fields to filter on (productdate, productstatus, ...)   don't think of this as products like consumer products.  products are like reports generated by different parts of the company if you will.  but only certain customers see certain products.

anyway - so I need to do an INSERT INTO database2 WHERE database1.product.productdate = this AND database1.product.status  = 'Completed'  etc
0
PatHartmanCommented:
Let me jump in here with "Access is NOT a spreadsheet".  I'm not sure why you feel the need to copy data from one set of tables in the master database to an empty (I presume) set of tables in a different database.  Why would you not simply use a query with arguments in the main database and not copy anything?
0
Keyboard CowboyAuthor Commented:
Yes, I would link to product and then product1 - populate product1 - drop product1 link to another database with product (now as product1)..... rinse repeat.

I'd even like to set this up so I can give it a list of databases and filter parameters and it does the whole shooting match without me in the middle  -   I know how to do that.
0
Keyboard CowboyAuthor Commented:
@PatHartman - that is not possible  - see above.  I need a subset of the data to GIVE to someone on a different network - the various customer networks are not attached in any way (think of them as different companies with their own shared drive and they only are allowed to look (not update) certain products and associated tables.
0
PatHartmanCommented:
Then you need to create a procedure to control this yourself.  
Create a template database with whatever objects need to be there and empty tables.  The user should not have to do anything except enter the selection criteria and press a button.  Your code will make a copy of the template as a new database, link to it, and run a series of append queries that copy the selected data.  You will have complete control over the table names.  If you link to the template once and just leave the links, then after you copy the empty template as a new db, use VBA to refresh the links and specify the name of the db you just created.  The linked table names won't change, they will simply now point to the new db.
0
grendel777Commented:
Got it. I think you're going to have to run your filters and copy the sub-records into a new table, copy/paste/export them into something like Excel or a CSV, and then import them into the cilent's sub-database. Access has an Export function, but you can't just export certain records. Here's some info on that. And here's info on exporting to Excel.

You might be able to get some VBA working that will do the export for you, and then possibly the import, too. Here's some discussion on how to get that started.
0
Keyboard CowboyAuthor Commented:
I was trying to create a procedure.  I have an empty version of the database ready to go.  Please see my original question.  I need the VBA to copy from one database to another.  
I think I'll just link to the empty database - depend on the table names being <oldname>1 etc. then just insert into oldname1 from source database I guess.  anyway -

thanks everyone but I don't see a solution above to my orginial question.
0
Jeffrey CoachmanMIS LiasonCommented:
Again,...in a well designed database, ...none of this complexity would be needed...

From all of the Expert's comments here, ...this seems like just a workaround for an inefficient design.

It looks like someone painted themselves in a corner, and having you create this complicated system of copying data, and making/breaking links, is the only way to "make things work"

One example: (in a very broad sense)
Giving each Customer a copy of their unique data should only require "Filtering", ...not creating a dedicated "Database" for each customer...

I am sure there is a solution to do what you are after, in the manner you are requesting...

But in a true "relational" db, complicated workarounds like this tend to wreak havoc when things don't go as planned...

Think about a system where this seems to be working fine, ...then you notice that you missed something, ...how would you go back through all you listed here and correct the data?

With a system this complex, you need to make sure you have rock solid error handling and "rollbacks" in place...


JeffCoachman
0
grendel777Commented:
@JeffCoachman, remember that Access isn't just a data store, though, it's also forms and reports and queries, etc. I'm sure the clients need the whole Access ecosystem for his application, which makes his process a reasonable solution.

Maybe look into creating a SharePoint solution in the future: all the data would be in one place and the clients would log in any time to see the most recent products for them, filtered by rules telling it who can see what. Until then, you'll just need to do more research into writing the VBA you need to split the data up, which is simply too big a task for us to cover here. Post questions as you run into trouble on pieces of the puzzle, though.
0
Jeffrey CoachmanMIS LiasonCommented:
@grendel777
Not to go off a tangent but:
I'm sure the clients need the whole Access ecosystem for his application, which makes his process a reasonable solution.
One can never really be "sure" of another developers design unless he has intimate knowledge of the entire scope of the application...
Again, in 11 years here (over 8,000 answers) I have never seen a question quite like this.

I don't doubt that the proposed "workaround" is reasonable, ...my concern was with the overall design...

In any event, ...all of this may be a moot point, as the OP has stated:
thanks everyone but I don't see a solution above to my orginial question.


JeffCoachman
0
PatHartmanCommented:
One of my applications performs benefits audits.  The audit is usually done by a third-party provider who is simultaneously performing multiple audits for multiple clients.  At the end of an audit, the application exports all the data for a specific audit into a template database and the template database is sent to the client to keep for his records.  Once the archive is created, the audit data is deleted from the third-party provider's database.  The template database includes a menu and some reports and forms for viewing but obviously no update capability.  The tables are empty.  The application copies the template from the backup folder to the output folder and refreshes the table links.  It then runs a dozen or so append queries.  The append queries include the autonumber PKs so that the relationships do not break as the data is exported.

This application is sold to various companies and so it must run in a number of environments.  In my case, the selection criteria is always an audit.  I can't tell how variable your criteria needs to be.  Probably all you need is one identifier and that will pull all the data from all the tables assuming you run the queries in the appropriate order.

I've included the code that copies the template, relinks the tables and populates them.  Hopefully there are enough comments so you get the gist of how it works.
Private Sub cmdSpecialArchive_Click()
    Dim strMsg As String
    
On Error GoTo Proc_Err

    If Me.Dirty Then
        DoCmd.RunCommand acCmdSaveRecord
    End If
    
    If DLookup("ItemName", "qGetAuditType", "AuditParmsID = " & Forms!frmLogin!cboAuditParmsID) = "New Hires" Then
        MsgBox "New Hires must be archived individualy.  Use the archive button on the subscriber form.", vbOKOnly
        MsgBox "Archive is cancelled", vbOKOnly
        Me.txtName.SetFocus
        Me.cmdArchive.Enabled = False
        Me.cmdSpecialArchive.Enabled = False
        Exit Sub
    End If
    
    strMsg = "Are you certain that you want to archive this audit?  "
    strMsg = strMsg & "Archiving the audit will create a back up database with all the data "
    strMsg = strMsg & "but will remove it PERMANENTLY from the active audit database."
    strMsg = strMsg & vbCr & "You will need the help of Maggio Solutions to restore this data."
    strMsg = strMsg & vbCr & "Make sure that you have created any necessary reports to save with the archive."
    strMsg = strMsg & vbCr & vbCr & "Select Yes to archive or No to cancel."
    If MsgBox(strMsg, vbYesNo + vbQuestion) = vbYes Then
        If MsgBox("All data for the current audit will now be removed from the active database.", vbYesNo + vbQuestion) = vbYes Then
            DoCmd.RunMacro ("mWarningsOff")
            Call CreateExtendedArchive
            Forms!frmLogin!cboAuditParmsID.Requery
            Me.txtName.SetFocus
            Me.cmdArchive.Enabled = False
            Me.cmdSpecialArchive.Enabled = False
            DoCmd.RunMacro ("mWarningsOn")
        Else
            MsgBox "The Archive request has been cancelled.", vbOKOnly + vbInformation
        End If
    Else
        MsgBox "The Archive request has been cancelled.", vbOKOnly + vbInformation
    End If
    
Proc_Exit:
    Exit Sub
    
Proc_Err:
    MsgBox Err.Number & "--" & Err.Description, vbCritical
    Resume Proc_Exit
End Sub

Public Sub CreateExtendedArchive()
    Dim ws As DAO.Workspace
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim FromFileName As String
    Dim ToFileName As String
    Dim bePath As String
 '   Dim strFileName As String
    Dim strPath     As String
    Dim fs          As Scripting.FileSystemObject

On Error GoTo Proc_Err

    Set db = CurrentDb()    ' delete links
    db.TableDefs.Delete "TEMPtblReviewStatus"
    db.TableDefs.Delete "TEMPtblStatus"
    db.TableDefs.Delete "TEMPtblRoles"
    db.TableDefs.Delete "TEMPtblListValues"
    db.TableDefs.Delete "TEMPtblAuditParms"
    db.TableDefs.Delete "TEMPtblDocuments"
    db.TableDefs.Delete "TEMPtblMembers"
    db.TableDefs.Delete "TEMPtblRefDocs"
    db.TableDefs.Delete "TEMPtblDependents"
    db.TableDefs.Delete "TEMPtblHelpComments"
    db.TableDefs.Delete "TEMPtblLtrSent"
    db.TableDefs.Delete "TEMPtblVerificationPhase"
    db.TableDefs.Delete "TEMPtblTPA"
    db.TableDefs.Delete "TEMPtblComments"
    
    
    'Get default Workspace
    Set ws = DBEngine.Workspaces(0)
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    If Forms!frmTPAName!txtPathName & "" = "" Then
        MsgBox "Please select destination folder for the archive database.", vbOKOnly + vbInformation
        Forms!frmTPAName!txtPathName.SetFocus
        Exit Sub
    Else
        strPath = Forms!frmTPAName!txtPathName
        If Right(strPath, 1) = "\" Then
        Else
            strPath = strPath & "\"
        End If
    End If

    If Forms!frmTPAName!txtDatabaseName & "" = "" Then
        MsgBox "Please enter a name for the archive database.", vbOKOnly + vbInformation
        Forms!frmTPAName!txtDatabaseName.SetFocus
    Else
        ToFileName = strPath & Forms!frmTPAName!txtDatabaseName
    End If
    
    'Make sure there isn't already a file with the name of the new database
    If Dir(ToFileName) <> "" Then Kill ToFileName
    
    'Create a new accdb file
    bePath = DLookup("JetPath", "UsysConnectionString", "LinkedID = 1")
    FromFileName = bePath & "AuditArchiveTemplateVer49.accdb"
    fs.CopyFile FromFileName, ToFileName, True
    
    Set db = ws.OpenDatabase(ToFileName)
    
    'link tables from archive database
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblReviewStatus", "TEMPtblReviewStatus"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblStatus", "TEMPtblStatus"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblRoles", "TEMPtblRoles"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblListValues", "TEMPtblListValues"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblAuditParms", "TEMPtblAuditParms"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblDocuments", "TEMPtblDocuments"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblMembers", "TEMPtblMembers"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblRefDocs", "TEMPtblRefDocs"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblDependents", "TEMPtblDependents"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblHelpComments", "TEMPtblHelpComments"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblLtrSent", "TEMPtblLtrSent"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblVerificationPhase", "TEMPtblVerificationPhase"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblTPA", "TEMPtblTPA"
    DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblComments", "TEMPtblComments"
    
    db.TableDefs.Refresh        'needed because Access doesn't always "see" the new table quickly
 
    'Using embedded SQL because Access "breaks" queries by changing all solumn names to "ExprX" if the tables they link to do not exist
    DoCmd.RunSQL ("Insert Into TEMPtblAuditParms Select * From tblAuditParms  Where AuditparmsID = " & Forms!frmLogin!cboAuditParmsID)
    DoCmd.RunSQL ("Insert Into TEMPtblReviewStatus Select * From tblReviewStatus")
    DoCmd.RunSQL ("Insert Into TEMPtblStatus Select * From tblStatus")
    DoCmd.RunSQL ("Insert Into TEMPtblRoles Select * From tblRoles")
    DoCmd.RunSQL ("Insert Into TEMPtblListValues Select * From tblListValues  Where AuditparmsID = " & Forms!frmLogin!cboAuditParmsID)
    DoCmd.RunSQL ("Insert Into TEMPtblDocuments Select * From tblDocuments")
    DoCmd.RunSQL ("Insert Into TEMPtblMembers Select * From tblMembers Where AuditparmsID = " & Forms!frmLogin!cboAuditParmsID)
    DoCmd.RunSQL ("Insert Into TEMPtblRefDocs SELECT tblRefDocs.* FROM tblMembers INNER JOIN tblRefDocs ON tblMembers.EmpID = tblRefDocs.EmpID WHERE tblMembers.AuditParmsID = " & [Forms]![frmLogin]![cboAuditParmsID])
    DoCmd.RunSQL ("Insert Into TEMPtblDependents SELECT tblDependents.* FROM tblMembers INNER JOIN tblDependents ON tblMembers.EmpID = tblDependents.EmpID WHERE tblMembers.AuditParmsID = " & [Forms]![frmLogin]![cboAuditParmsID])
    DoCmd.RunSQL ("Insert Into TEMPtblHelpComments SELECT tblHelpComments.* FROM tblMembers INNER JOIN tblHelpComments ON tblMembers.EmpID = tblHelpComments.EmpID WHERE tblMembers.AuditParmsID = " & [Forms]![frmLogin]![cboAuditParmsID])
    DoCmd.RunSQL ("Insert Into TEMPtblLtrSent SELECT tblLtrSent.* FROM tblMembers INNER JOIN tblLtrSent ON tblMembers.EmpID = tblLtrSent.EmpID WHERE tblMembers.AuditParmsID = " & [Forms]![frmLogin]![cboAuditParmsID])
    DoCmd.RunSQL ("Insert Into TEMPtblVerificationPhase SELECT tblVerificationPhase.* FROM tblMembers INNER JOIN (tblDependents INNER JOIN tblVerificationPhase ON tblDependents.DepID = tblVerificationPhase.DepID) ON tblMembers.EmpID = tblDependents.EmpID WHERE tblMembers.AuditParmsID = " & [Forms]![frmLogin]![cboAuditParmsID])
    DoCmd.RunSQL ("Insert Into TEMPtblTPA Select * From tblTPA")
    DoCmd.RunSQL ("Insert Into TEMPtblComments Select tblComments.* FROM tblMembers INNER JOIN (tblDependents INNER JOIN tblComments ON tblDependents.DepID = tblComments.DepID) ON tblMembers.EmpID = tblDependents.EmpID WHERE tblMembers.AuditParmsID = " & [Forms]![frmLogin]![cboAuditParmsID])
    
    If Environ("UserName") = "Pat" Then     'give me a chance to cancel delete so I can keep testing with the same data
        If MsgBox("Do you want to finish the archive?", vbYesNo + vbQuestion) = vbNo Then
            Exit Sub
        End If
    End If

    
    'update audit archive date in audit log
    
    Set db = CurrentDb()
    Set qd = db.QueryDefs!qAuditLog
        qd.Parameters![enterauditparmsid] = Forms!frmLogin!cboAuditParmsID

    If Forms!frmLogin!cboAuditParmsID <> 1 Then 'don't update for training audit
        Set rs = qd.OpenRecordset
            rs.Edit
            rs!AuditArchiveDate = Date
            rs!AuditName = Forms!frmLogin!cboAuditParmsID.Column(2)
            rs!CoName = Forms!frmLogin!cboAuditParmsID.Column(3)
            rs!CoAbbr = Forms!frmLogin!cboAuditParmsID.Column(4)
            rs!UpdatedBy = Forms!frmLogin!txtUserID
            rs.Update
            
        rs.Close
    End If
    
    'set properties of archive database to make seeing objects more difficult.  No db is secure.
    Call SetStartupProperties(ToFileName)
    
    'rename new archive to .accdr
    FromFileName = ToFileName
    ToFileName = Left(ToFileName, Len(ToFileName) - 1) & "r"
    'Make sure there isn't already a file with the name of the new database
    If Dir(ToFileName) <> "" Then Kill ToFileName
    Name FromFileName As ToFileName
  

    If Forms!frmLogin!cboAuditParmsID = 1 Then
        MsgBox "The archive was created but the data will not be deleted because it is needed for the correct operation of the DEA application.", vbOKOnly + vbInformation
    Else
        'Delete archived data from database
        DoCmd.OpenQuery "qDeleteArchivedAudit"
    End If
    
    MsgBox "Export Complete." & vbCr & " Your Archive is: " & vbCr & vbCr & ToFileName, vbOKOnly + vbInformation
    
    db.Close
    Set db = Nothing
Proc_Exit:
    Exit Sub
Proc_Err:
    Select Case Err.Number
        Case 53
            MsgBox "DEA audit template database could not be found.", vbOKOnly + vbInformation
        Case 3265
            Resume Next
        Case Else
            MsgBox Err.Number & "--" & Err.Description, vbCritical
            Resume Proc_Exit
    End Select
End Sub

Open in new window

Archive form in design view
0
PatHartmanCommented:
I just noticed that there were a couple more called procedures.  These are way beyond the scope of your question but you might be interested in what they do.  Keep in mind, the objective of the archive code I posted is to create a fully functioning application that the client can keep for historical purposes should he have any questions regarding the details of his audit.  Also, the design of the code was dictated in some respects by the fact that it was being run from a compiled application and so there were some simple techniques that couldn't be used because they wouldn't work from an .accde.

Public Function SetStartupProperties(strDB)
    Dim dbs As DAO.Database
    Dim prp As Object
    Dim strTitle As String

    Const PROPERTY_NOT_FOUND As Integer = 3270
    Const TEXT_TYPE As Integer = 10  ' Equivalent to DAO dbText data type.
    Const BOOL_TYPE As Integer = 1   ' Equivalent to DAO dbBoolean data type.
    Const LONG_TYPE As Integer = 4   ' Equivalent to DAO dbLong data type.
    
    On Error GoTo ErrorHandler
  
    Set dbs = DBEngine.Workspaces(0).OpenDatabase(strDB)
    strTitle = "Dependent Eligibility Auditor®TM    Proprietary Information"

    ' Try to set the property. If it fails, the property does not exist.
    On Error Resume Next
    dbs.Properties("AppTitle") = strTitle
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AppTitle", TEXT_TYPE, strTitle)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
                Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
 

    dbs.Properties("AllowFullMenus") = False
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AllowFullMenus", BOOL_TYPE, False)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
    dbs.Properties("AllowShortcutMenus") = True
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AllowShortcutMenus", BOOL_TYPE, True)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
    dbs.Properties("StartupShowDBWindow") = False
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("StartupShowDBWindow", BOOL_TYPE, False)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
    dbs.Properties("AllowBuiltInToolbars") = False
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AllowBuiltInToolbars", BOOL_TYPE, False)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
    dbs.Properties("AllowToolbarChanges") = False
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AllowToolbarChanges", BOOL_TYPE, False)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
    dbs.Properties("AllowBypassKey") = False
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AllowBypassKey", BOOL_TYPE, False)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select
    dbs.Properties("AllowBreakIntoCode") = False
        Select Case Err.Number
            Case PROPERTY_NOT_FOUND
            ' Create the new property.
                Set prp = dbs.CreateProperty("AllowBreakIntoCode", BOOL_TYPE, False)
                dbs.Properties.Append prp
                Resume Next
            Case 0
               ' Refresh the title bar to reflect the change.
               ' Application.RefreshTitleBar
            Case Else
                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
                GoTo ExitLine
        End Select

''    dbs.Properties("AllowSpecialKeys") = False
''        Select Case Err.Number
''            Case PROPERTY_NOT_FOUND
''            ' Create the new property.
''                Set prp = dbs.CreateProperty("AllowSpecialKeys", BOOL_TYPE, False)
''                dbs.Properties.Append prp
''                Resume Next
''            Case 0
''               ' Refresh the title bar to reflect the change.
''                Application.RefreshTitleBar
''            Case Else
''                MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly+vbInformation
''                GoTo ExitLine
''        End Select

    Call SetMDBAppIcon
    
ExitLine:
   dbs.Close
   Set dbs = Nothing
   Set prp = Nothing
   Exit Function

ErrorHandler:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
            Resume ExitLine
    End Select
End Function

Public Sub SetMDBAppIcon()
   Dim dbs As Object
   Dim prp As Object
   Dim strIcon As String
   Dim strPath As String

   Const PROPERTY_NOT_FOUND As Integer = 3270
   Const TEXT_TYPE As Integer = 10   ' Equivalent to DAO dbText data type.
   Const BOOL_TYPE As Integer = 1    ' Equivalent to DAO dbBoolean data type.
   Const LONG_TYPE As Integer = 4    ' Equivalent to DAO dbLong data type.

   On Error GoTo ErrorHandler

   Set dbs = Application.CurrentDb
   strPath = Left(CurrentDb.Name, InStrRev(CurrentDb.Name, "\"))
   'strPath = GetDBPath()
   strIcon = strPath & "People.ico"
  
   dbs.Properties("AppIcon") = strIcon  ' Try to set the property. If it fails, the property does not exist.
   Application.RefreshDatabaseWindow
 '  Application.RefreshAppIcon   ' Refresh the icon to reflect the change.

ExitLine:
   dbs.Close
   Set dbs = Nothing
   Set prp = Nothing
   Exit Sub

ErrorHandler:
   If Err.Number = PROPERTY_NOT_FOUND Then       ' Create the new property.
      Set prp = dbs.CreateProperty("AppIcon", TEXT_TYPE, strIcon)
      dbs.Properties.Append prp
      Resume Next
   Else
      Resume ExitLine
   End If

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
Given your further postings. to me the process would be something like this:

1. As suggested by other Experts, create a Template database containing all the objects needed to run the application, including empty table structures.
2. Create a "loader" application where you define (a) the source databases and (b) the filtering criteria. You'd probably need code in this db to allow the user to select the source databases, and the specific tables in those source databases you'll use to create the data subsets.
3. Using the loader db, create a copy of the Template database. You can use a simple FileCopy command for that.
4. Using VBA code in the loader, fill the tables in the copy created in step 3.

If that's something like the process you're envisioning, then the suggestions from Pat should help tremendously.

Personally, I'd link the tables needed from the sources into the copy (create those in VBA, and you have full control over the names and such), and then use standard INSERT statements to fill those empty tables with data. Once you're done with that, delete the links you made in the copy (again, with VBA) and you should be ready to pass the copy along to who needs to use it.

If this is a 'read only' sort of process - that is, the copy is only for reporting and viewing - then you're okay with this. If you need to copy data back into the source databases, however, you're in for a LOT more work.

Here's how to create links in your copied database:

Dim dbs As DAO.Database
Dim tdf As DAO.TableDef

Set dbs = OpenDatabase("Path to the copy")
Set tdf = dbs.CreateTableDef("YourTableName")
With tdf
   .Connect = ";DATABASE=PathToTheSourceDB"
   .SourceTableName = "TableNameInTheSourceDB"
End With

dbs.TableDefs.Append tdf

To remove that table in the copy:

dbs.Execute "DROP TABLE YourTableName"
0
Keyboard CowboyAuthor Commented:
Very helpful with the code examples - thanks for taking the time.
0
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
The comment you accepted showed how to set startup properties, and doesn't really show how to resolve the problem you stated. Can you please explain why you chose that comment (and ONLY that comment) as your solution?
0
Keyboard CowboyAuthor Commented:
That was the main one which posted code which is helpful as were others Pat wrote.  The other comments mostly argued with the point of trying to do what I needed to do in the first frankly.  There were other comments which was helpful but that one was the most helpful IHMO.  I'm not sure I didn't realize I needed to explain myself on which comments spoke to the problem I was attempting to describe.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.