How to Run different database query in ms access Form - vba

I have following code to run saved query and export data to excel report.
How should I change the code if this query is in a different database?
DoCmd.Requery Q_Check_Mismatches
DoCmd.RunSavedImportExport "Export-Q_Check_Mismatches"
I know we can link all relevant tables to current database and then run the query locally. But I need this
because of DB size issue.
Appreciate your response
Cheers
Shabar

Following code worked for me
Function QueryRun(strDBPath As String, strImportExport As String)
Dim objAccess As Access.Application
Set objAccess = CreateObject("Access.Application")
objAccess.OpenCurrentDatabase
strDBPath objAccess.DoCmd.RunSavedImportExport strImportExport
objAccess.CloseCurrentDatabase
objAccess.Quit
Set objAccess = Nothing
End Function
Cheers
Shabar

Related

Changing Linked Table Source Access 2016

I am trying to change the links in an Access 2016 database, but the method I've used in the past is not working as required.
I am using the
t.connect="new connection"
t.refreshlink
method, where t is a the table.
I have seen in the linked table manager that the tables are now grouped by a data source. I can create the new source and link it to the desired table, but I have many as migrating, so would like to do this in code.
I get no errors the current way, but immediately after the .refreshlink the table's .connect is still the same.
Is this still possible?
I currently populate a dictionary with the table name and it's existing connection, but only if non ODBC.
I am then looping through this dictionary, getting the table and changing its connection
CurrentDb.TableDefs(strTableName).Connect = strNewConnection
CurrentDb.TableDefs(strTableName).RefreshLink
Debug.Print CurrentDb.TableDefs(strTableName).Connect
Existing connection = ;DATABASE=\\app01\Access\CRM_Data.mdb
New connection =;DATABASE=C:\CRM_TEST\CRM_DATA_BE_2016.accdb
Many thanks
You should not use CurrentDb.TableDefs when changing tables, as that changes between calls and makes the reference to the tabledef where you change the connection string be a different one than the one where you refresh the link.
Dim d As DAO.Database
Set d = CurrentDb
d.TableDefs(strTableName).Connect = strNewConnection
d.TableDefs(strTableName).RefreshLink
AFAIK this behaviour is not version-dependent, so the code you provided should never have worked.
I am using this code in Access 2016 and it works just fine:
Public Function RelinkTables(environment As Integer)
On Error Resume Next
Dim tblDef As DAO.TableDef
For Each tblDef In CurrentDb.TableDefs
If tblDef.Connect <> "" Then
tblDef.Connect = GetConnectionString(environment)
tblDef.RefreshLink
End If
Next
End Function
Public Function GetConnectionString(environment As Integer) As String
Select Case environment
Case 1 ' connection to Test db
GetConnectionString = "your connection string to Test"
Case 2 ' connection to Prod db
GetConnectionString = "your connection string to Production"
End Select
End Function
If this would not work with your db than may be the path is wrong.

Adding Computer name or User ID to new record in Access

I'm attempting to setup a simple function to add the computer name of the person who adds a record into an access database. For example if user on computer 12345 creates a new record into table tblTasks then in the field "Owner" it would put that persons computer name.
The way I'm going about this currently (And not sure it's the best way) is, on the form under the field "Owner" I have set the Default value to =owner and I have created the following function:
Function Owner()
Dim cdb As DAO.Database, rst As DAO.Recordset
Dim wshNet As Object
Set wshNet = CreateObject("Wscript.Network")
Set cdb = CurrentDb
Set rst = cdb.OpenRecordset("SELECT * FROM tblTasks", dbOpenDynaset)
rst.AddNew
rst!Owner = wshNet.Computername
rst.Update '<---- Error starts here
Set wshNet = Nothing
End Function
I'm getting the following error when creating a new record:
I know part of the issue is to do with a validation rule I created not allowing a record to be created without a Task Name but I want to keep that in place.
I'm thinking the issue of the "Owner" field giving an #Error is also to do with the fact that instead of using a button action to create a record I am keeping the ability to just add from the bottom of the record. Which I'd also like to keep in tact.
Any help or advice would be greatly appreciated!
Thanks!!
-Deke
I worked on something similar a few days ago and started using the fields like you. I found a solution similar to the macro that you have.
Create a macro event for the form's BeforeInsert property. Use the below code for the macro and update to fit your needs.
Private Sub Form_BeforeInsert(Cancel As Integer)
Dim Owner As String
Owner = Environ("COMPUTERNAME")
Me!AddedBy= Owner
End Sub
EDIT
Regarding the error that you're receiving, I'm not sure if this will help, but try defining Owner as
Dim wshNet As String
Set wshNet = Environ("COMPUTERNAME")

MS Access VBA code

I am new to MS Access and would like to type EmployeeID in the text box 1 (text_in) and after the button is pressed the result query (one unique value e.g. employee first name taken from the table) is printed out in the text box2 (text_out).
So far have the following code:
Private Sub btn_get_data_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
'declaration of database on recordset objects
Dim strSQL As String
Dim a As String
a = text_in.Value
Set db = CurrentDb
Set rs = db.OpenRecordset("Employee")
strSQL = "SELECT Employee.FirstName FROM Employee WHERE Employee.EmployeeId=" & a
Set db = Nothing
Set rs = Nothing
End Sub
I have tried searching for a solution in many places but I cannot understand the structure that is used in MS access VBA to implement query from regular SQL language.
Guys, thank you very much! It took me one more hour to sucessfully implement both solutions into my database file. As I wrote I am completely new to Ms-access I am learning using some tutorials but my level is still low. Thank you very much once again.
Private Sub btn_get_data_Click()
on error goto errorCatch
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT Employee.FirstName FROM Employee WHERE Employee.EmployeeId=" & Me.text_in.Value & ";"
Set rs = db.OpenRecordset(strSql, DbOpenDynaset)
If rs.RecordCount > 0 Then
debug.print; rs!FirstName
Me.text_out.Value = rs!FirstName
End if
Cleanup:
Set db = Nothing
Set rs = Nothing
Exit Sub
errorCatch:
debug.print; err.Number
debug.print; Err.Description
GoTo Cleanup
End Sub
I cant tell what youre after is this. You need to be better at utilizing recordsets and how to use a string value as your sql statement.
You also didnt need to create a variable to store the textbox value in- you can use it directly in your sql statement.
Also it is very important to have good error handling as hanging recordset objects can be quite a pain in the ass.
EDIT - Ill expand on other ways to use string sql statements within VBA
DoCmd.RunSQl strSql
Or
DoCmd.Execute strSql
Both of these are great for UPDATE's or INSERT's.
Then, like Gustav pointed out, you have various D functions that are basically compact queries with some limitations. However, they often save you the trouble of having to do all the typing that is involved with opening,utlizing and closing records sets. Even though the D functions seem limited, I have often nested a few to get join results out of. Just a matter of imagination.
Look at this nifty site for function details -
https://www.techonthenet.com/access/functions/index.php
You don't need a query to do this. Just set the ControlSource of text2:
=DLookup("FirstName","Employee","EmployeeId=" & [text_in] & "")

How can a blank MS Access database be created using VBA?

I'm a total noob trying to create a blank MS Access database using VBA in Excel. I want to name the new database "tblImport". This is the code I´m using:
Sub makedb()
Dim accessApp As Access.Application
Set accessApp = New Access.Application
accessApp.DBEngine.CreateDatabase "C:\tblImport.accdb", dbLangGenera
accessApp.Quit
Set accessApp = Nothing
End Sub
I get the following error message:
"Run Time Error 3001: Application Defined or Object Defined Error"
What can I do?
The name of the locale constant in the CreateDatabase method is wrong:
This:
accessApp.DBEngine.CreateDatabase "C:\tblImport.accdb", dbLangGenera
Should be:
accessApp.DBEngine.CreateDatabase "D:\tblImport.accdb", DB_LANG_GENERAL
Change that and your code should work. (It does for me at least).
Old Question. Here are my two cents. You have a typo...
dbLangGenera should be dbLangGeneral
More about it in Workspace.CreateDatabase Method (DAO)
Voting to close this question as per Dealing with questions with obvious replies
Try this. This works.
Sub makedb()
Dim accessApp As Access.Application
Set accessApp = New Access.Application
accessApp.DBEngine.CreateDatabase "C:\tblImport.accdb", dbLangGeneral
accessApp.Quit
Set accessApp = Nothing
End Sub
EDIT: Will delete this answer and post it as a comment once the post is closed.
Old question, but it was useful for me. Seems like you don't even need Access object.
Access.DBEngine.CreateDatabase "D:\tblImport.accdb", DB_LANG_GENERAL
works fine for me.
You should use the first method if you intend to use the automation object you've created. You can open forms, use DoCmd statements, etc., simply by prefacing each statement with "accessApp." For example, I use TempVars to hold user data. I can open a related database using automation, then do
accessApp.TempVars.Add "CurrentUser", TempVars.CurrentUser
to pass the CurrentUser value from the active database to the new database.
When all you want to do is create a new database to do a function such as DoCmd.TransferDatabase on, you can just use
Access.DBEngine.CreateDatabase "D:\tblImport.accdb", DB_LANG_GENERAL

Changing linked table location programmatically

I have an Access database with a linked table in a second database, located in the same directory as the first.
I would like to copy the whole directory to a new location (for testing) and have database one still link to the table in database two, but the linkage is still to the original directory, not the new location.
I'd like to do one of two things: either
Make the link to the table in database two in such a way that the folder path is relative - that the path to database two isn't hardcoded.
or
Have a routine in Form_Load (or an autoexec macro) that checks the application.path and programmatically adjusts the linkage accordingly.
Thanks,
I used it succesfull, however did not use it with the recordset.
Const LnkDataBase = "C:\NorthWind.mdb"
Sub relinktables()
'Routine to relink the tables automatically. Change the constant LnkDataBase to the desired one and run the sub
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strTable As String
Set dbs = CurrentDb()
For Each tdf In dbs.TableDefs
If Len(tdf.Connect) > 1 Then 'Only relink linked tables
If tdf.Connect <> ";DATABASE=" & LnkDataBase Then 'only relink tables if the are not linked right
If Left(tdf.Connect, 4) <> "ODBC" Then 'Don't want to relink any ODBC tables
strTable = tdf.Name
dbs.TableDefs(strTable).Connect = ";DATABASE=" & LnkDataBase
dbs.TableDefs(strTable).RefreshLink
End If
End if
End If
Next tdf
End Sub
It can be useful to have a start-up form that allows you to browse for the back-end you want and a table of the tables that should be linked. You could iterate through the tables collection, but i think a list is slightly safer. After that, a little code is all that is needed, here is a snippet:
''Connection string with database password
strConnect = "MS Access;PWD=pw;DATABASE=" & Me.txtNewDataDirectory
Set rs = CurrentDb.OpenRecordset("Select TableName From LinkTables " _
& "WHERE TableType = 'LINK'")
Do While Not rs.EOF
''Check if the table is already linked, if it is, update the connection
''otherwise, link the table.
If IsNull(DLookup("[Name]", "MSysObjects", "[Name]='" & rs!TableName & "'")) Then
Set tdf = db.CreateTableDef(rs!TableName, dbAttachSavePWD, _
rs!TableName, strConnect)
db.TableDefs.Append tdf
Else
db.TableDefs(rs!TableName).Connect = strConnect
End If
db.TableDefs(rs!TableName).RefreshLink
rs.MoveNext
Loop
I used usncahill's solution and modified it for my own needs. I do not have enough reputation to vote up their solution, so if you like my additional code, please vote us both up.
I wanted a quick way to switch between two back-end databases, one containing live data and the other containing test data. So I modified the previously mentioned code as follows:
Private Sub ReplaceLink(oldLink As String, newLink As String)
Dim tbl As TableDef, db As Database
Set db = CurrentDb
For Each tbl In db.TableDefs
If InStr(tbl.Connect, oldLink) > 0 Then
tbl.Connect = Replace(tbl.Connect, oldLink, newLink)
tbl.RefreshLink
End If
Next
End Sub
Public Function ConnectTestDB()
ReplaceLink "Data.accdb", "Test.accdb"
End Function
Public Function ConnectLiveDB()
ReplaceLink "Test.accdb", "Data.accdb"
End Function
Public Function TestDBSwitch()
Dim tbl As TableDef, db As Database
Dim wasData As Boolean
Dim wasTest As Boolean
wasData = False
wasTest = False
Set db = CurrentDb
For Each tbl In db.TableDefs
If InStr(tbl.Connect, "JGFC Flooring Data") > 0 Then
wasData = True
ElseIf InStr(tbl.Connect, "JGFC Flooring Test") > 0 Then
wasTest = True
End If
Next
If wasData = True And wasTest = True Then
MsgBox "Data Mismatch. Both Test and Live Data are currently linked! Connecting all tables to Test database. To link to Live database, please run again.", , "Data Mismatch"
ConnectTestDB
ElseIf wasData = True Then
ConnectTestDB
MsgBox "You are now connected to the Test database.", , "Connection Changed"
ElseIf wasTest = True Then
ConnectLiveDB
MsgBox "You are now connected to the Live database.", , "Connection Changed"
End If
End Function
(The previous code assumes that both the Test and Live Data files are located in the same directory and the file name ends in Test and Data, but can be easily modified to other paths/filenames)
I call TestSwitchDB from a button in my front-end DB to quickly change between testing and production environments. My Access DB has user controls to switch between user environments, so when the admin user logs in to the front-end DB, I use the ConnectTestDB function directly to default the admin user to connect to the test DB. I likewise, use the ConnectLiveDB function when other users login to the front-end.
There is also a quick error detection in the TestSwitchDB function to tell me if there are a mix of connections to both environments prior to calling the switch function. If this error is recurrent, it could be a sign of other issues.
Our corporate IT changed the pathing our shared files from local to corporate, which necessitated redirecting all of our database tables. This would have a been pain, to delete and recreate all the links, especially with multiple different databases linked. I found this question but neither of the other answers worked well for me. The following is what I used. Note, this will take awhile with many tables as each update might take a few seconds.
Public Sub Fix_Table_Locations()
Dim tbl As TableDef, db As Database, strConnect As String
Set db = CurrentDb
For Each tbl In db.TableDefs
If InStr(tbl.Connect, "Portion of connect string to change") > 0 Then
tbl.Connect = Replace(tbl.Connect, "Portion of connect string to change", "New portion of connect string")
tbl.RefreshLink
End If
Next
End Sub
You may be able to use a relative path depending on where the files are located. The default location where Access looks is in Documents (C:\Users\UserName\Documents). So if you enter .. then it will take you one folder up from Documents, which is the user's folder. For example if your database file will always be stored at
C:\Users\UserName\Access App\Access Database
Then you can enter "..\Access App\Database" as the relevant file location. Otherwise you have to use VBA. In my case the file/file folders may not always be in the same location, some users may store the files on their Google drive, while others may use My Documents or the desktop. I was able to use a function similar to what usncahill posted:
Sub relinkBackendDB()
Dim sFilePath As String
Dim connectionString As String
Dim tbl As TableDef
Dim db As Database
sFilePath = (Application.CurrentProject.Path & "\system\Dojo Boss Database.accdb")
connectionString = ("MS Access;PWD=MyPassword;DATABASE=" & sFilePath)
Set db = CurrentDb
For Each tbl In db.TableDefs
If Len(tbl.Connect) > 0 Then
'MsgBox tbl.Connect 'If you're getting errors, uncomment this to see connection string syntax
tbl.Connect = connectionString
tbl.RefreshLink
End If
Next
End Sub
I call this function via the on_load event procedure when my "Home" form loads up, so it gets called whenever the app is first loaded/opened. This way it will always look in the relevant file folder, no matter what the user name is.