Copy from one Access database to another (VBA) - vba

I need help to copy data from one Access database to another using VBA. The tables have the same layout and the both have an autonumber Primary Key field.
I tried the following:
strSQL = "INSERT INTO [tbl_items] SELECT * FROM [tbl_items] IN 'C:\temp\itemsdb.mdb';"
CurrentDb.Execute (strSQL)
The issue is that if the value of one Primary Key in first database is the same with one in the second database then that record is not copied.
Any ideas?

You don't even need VBA for this. Try it this way.
On the External Data tab, in the Export group, click Access.
Tip: You can also start the export process by right-clicking the object in the Navigation Pane and then clicking Export > Access.
Access opens the Export - Access Database dialog box.
In the File name box on the Export - Access Database dialog box, specify the name of the destination database and then click OK.
In the Export dialog box, change the name of the new object if you do not want to overwrite an existing object with the same name in the destination database.
If the selected object is a table, specify whether you want to export the table's definition and data, or only the definition.
Click OK to finish the operation.
If you really need a VBA solution, post back, and I'll provide a solution. In this scenario, it seems like VBA is overkill.

It is a process that I wanted to automate because it is repeated quite often; so I needed a solution in VBA.
I found the solution that I share below for future reference.
Public Sub AppendItems()
Dim strSQL As String
Dim fDialog As Object
Dim pickedFile As Boolean
Set fDialog = Application.FileDialog(3)
With fDialog
.AllowMultiSelect = False
.Title = "Please select a file to import:"
.Filters.Clear
.Filters.Add "Access Databases", "*.MDB"
End With
pickedFile = fDialog.Show
If pickedFile Then
fPath = fDialog.SelectedItems.Item(1)
End If
strSQL = "INSERT INTO [tbl_DestinationTable] SELECT [field1], [field2], [etc] FROM [tbl_SourceTable] IN'" & fPath & "';"
DoCmd.RunSQL (strSQL)
End Sub

Related

append data from form to column

I am working on a "issue tracker" access data base where the user enters there data through forms, create new form and edit form.
I have a comment section on my edit form which I have been requested to remained lock, for viewing purposes. So the user can only view the comments.
I have another box below that must "append" or add data to the comment section with a time and user stamp.
My approach is to create a vba code that will allow the user to enter data, and once entered will show in the locked comment section. As the user is working through a "editing" form.
I am fairly new to access and vba and unfortunately I cant find anything that I understand online.
Below is some code use and found searching online. I have but can figure out how to append ( or add ) it to the existing column. It is running fine but the data value I wish to add don't go anywhere?
Private Sub Add_Click()
Dim StrSQL As String
Dim addComments As String
' where addcomment.value is the value desire to append
addCommentStr = Me!addComment.Value
'where IssueTrack is Table, AdditionalComments is column
StrSQL = "INSERT INTO IssueTracker(AdditionalComments) VALUES ('" &
addCommentStr & "' );"
DoCmd.SetWarnings False
DoCmd.RunSQL StrSQL
DoCmd.SetWarnings True
MsgBox ("Comment Added")
End Sub
You wouldn't just keep on appending text to the same record. Where would you end?
So, skip all the code and create a form bound to the table.
Have one field for the date. Set its DefaultValue to: Now()
Set the form's property AllowEdits to: False

How to search database records from access using Microsoft Word using VBA

I'm looking to fill Text Form fields in Word with table entries from the company's Access Database.
So far I have a user form that populates the combo boxes with the company's Project Numbers. I would like to have that when the user submits the client information from the selected project is put into text form fields in the Word document.
My problem is searching the table for the Project Number and accessing the record. When I check the Recordset value after the 'Find First' function it returns the first record in the table.
Here is my Code so far:
'Access Database
Dim db As Database
Dim rst As Recordset
Dim strPath As String
Dim doc As Document
Set doc = ThisDocument
strPath = "string path name"
Set db = OpenDatabase(strPath)
Set rst = db.OpenRecordset("Word Report Query")
rst.FindFirst "Project Number = " & ProjectBox.Value
Using an Access form to select the correct record - should be set up using a combo box and following the wizard.
Word Merge is the feature set of Office where working with Word - one can set up a template that links to an Access table or query or excel sheet - - and that data source is used to insert the data into the Word template/doc.
Alternatively Access can be used to create a Report, and then export that as an rtf Word file.
I ended up using a while loop to search through the database. Probably not the best solution but the only way I could reliably find the recordset.
'Access Database
Dim db As Database
Dim rst As Recordset
Dim strPath As String
Dim doc As Document
Set doc = ThisDocument
strPath = "path name"
Set db = OpenDatabase(strPath)
Set rst = db.OpenRecordset("Word Report Query")
'Find Selected Record
Do While rst![Project Number] <> ProjectBox.Value
rst.MoveNext
Loop
ActiveDocument.FormFields("Company").Result = rst![Client]
ActiveDocument.FormFields("Email").Result = EmployeeBox.Value
ActiveDocument.FormFields("Date").Result = DateBox.Value
If rst![Consultant] <> Null Then
ActiveDocument.FormFields("Addressing").Result = rst![Consultant]
End If
There are no error checks for the project number because I use the database to populate the dropdown box options when the userform is initialized
'Populate Project Box Dropdown
Do While Not rst1.EOF
ProjectBox.AddItem rst1(0)
rst1.MoveNext
Loop

MS Access - SetFocus on multiple text boxes to check if data exists via SQL

The problem I'm facing:
I try to check if inserted text from multiple text boxes is already existing in a table before saving the records to avoid duplicates.
I created a form to enter new members and save them into a table. The key to avoid duplicates is to check the combination of given name, last name and birth date with existing records. (It's most likely that there won't be two person with all three criteria matching)
I have no problem to check the existence for only one text box by setting the focus on the desired box and use the SQL query IF EXISTS...
But since I would need to set focus on several text boxes(IMO) the problem occurs.
Is there a way to set focus on multiple text boxes?
The idea would be to use an IF EXISTS...AND EXISTS statement and I would need to implement the .SetFocus statement for each text box before checking its existence.
I hope you get my point and I would be glad if someone could share some knowledge. :)
Thanks in advance
There seems to be some missing information in order to find the best solution to your problem. so the below response will be based on assumptions as to how your form is working.
I'm assuming you are using an unbound form with unbound text boxes? if this is the case, then you must have a button that is the trigger for checking/adding this information to your table. lets say your command button is called "Save". You can use the following code without the need to .setfocus to any textbox.
Private Sub Save_Click()
Dim db as DAO.Database
Dim rst as DAO.Recordset
Dim strSQL as string
set db = currentdb 'This is the connection to the current database
'This is the SQL string to query the data on your table
strsql = "SELECT * " & _
"FROM [Yourtablename] " & _
"WHERE ((([YourTableName].[FirstName]) ='" & me.FormFirstNameField & "' AND ([YourTableName].[LastName]) ='" & me.FormLastNameField & "' AND ([YourTableName].[DOB]) =#" & me.FormDOBField & "#));"
set rst = db.openrecordset(strsql) 'This opens the recordset
if rst.recordcount <> 0 then
'Enter code to inform user information already exists
else
'Enter code if information does not exits
end if
rst.close 'Closes the recordset
set rst = nothing 'Frees memory
set db = nothing 'Frees Memory
End Sub
Let me know if this code works or if I need to make changes based on your scenario.

Hot to pass SQL query from Access form to external database ?

I have database created in postgreSql and working on front-end application using microsoft access forms. I want to send a query on a press of a button:
Private Sub Command5_Click()
Dim strSQL As String
strSQL = "INSERT INTO public_failedestimate (est_num,issue_date) SELECT est_num,issue_date FROM public_estimate WHERE est_num=1 ;"
DoCmd.RunSQL strSQL
End Sub
It works when debugging, but does not when i click the button. By the way, it located in button's on click event. thx
What you have should work. If there is any possibility that the current record in the form's bound record set is dirty, then you want to ensure that the record is written to the table BEFORE you run this code.
You can add these 3 lines of code right before your RunSQL command
If me.dirty = true then
Me.dirty = false
End if

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.