Trying to link table between Access DBs using VBA. Getting ISAM not found error - vba

I have a split database where both the front end and back end are accdb files. Because one of my tables uses the AppendOnly = Yes property, I cannot use the link table manager or the refreshlink property when I move the backend. The backend moves from time to time because my IT loves to reshuffle servers.
So my solution is to write a function which prompts for the backend location, deletes all the currently linked tables, and then loops through all the backend tables and links them to the frontend. On this last part I receive a run time error 3170 could not find suitable ISAM. I don't know why.
Code is below:
Public Function MoveDB()
'this function will replace the linked table manager. It will open a file select dialog box to allow the user to pick the new location of the DB backend.
'It will then break all the current links and then recreate them. We need to do this vice use the relink function because the cases table uses AutoAppend which stores old path data
' and breaks the relink function which is why linked table manager does not work.
' FileDialog Requires a reference to Microsoft Office 11.0 Object Library.
'variables to get the database path
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Dim DriveLetter As String
Dim NetworkPath As String
Dim DrivePath As String
Dim SubPath As String
'variables to link the database
Dim db As DAO.Database
Dim BEdb As DAO.Database
Dim oldtdf As DAO.TableDef
Dim tblName As String
Dim newtdf As DAO.TableDef
Dim BEtdf As DAO.TableDef
Set db = CurrentDb()
' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' Do not Allow user to make multiple selections in dialog box
.AllowMultiSelect = False
'set the default folder that is opened
.InitialFileName = CurrentProject.Path & "\BE"
' Set the title of the dialog box.
.Title = "Please select the Database Backend"
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Access Databases", "*.accdb"
' Show the dialog box. If the .Show method returns True, the
' user picked a file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'We need to determine the full network path (including server name) to the DB backend. The reason is that different users may have the share drive mapped with different letters.
'If the backend is mapped using the drive letter of the user moving the DB then other users may not have a valid path. The full network path is universal
'Get the mapped drive letter from the path of the selected DB file
DriveLetter = Left$(Trim(fDialog.SelectedItems(1)), 2)
'Get the path of the selected DB file minus the drive letter
SubPath = Mid$(Trim(fDialog.SelectedItems(1)), 3)
'Get the full network path of the mapped drive letter
DrivePath = GETNETWORKPATH(DriveLetter)
'Combine the drive path and the sub path to get the full path to the selected DB file
NetworkPath = DrivePath & SubPath
'MsgBox (NetworkPath)
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
'Now we need to delete all the linked tables
For Each oldtdf In db.TableDefs
With oldtdf
If oldtdf.Attributes And dbAttachedODBC Or oldtdf.Attributes And dbAttachedTable Then
'this is a linked table
tblName = .Name
DoCmd.DeleteObject acTable, tblName
End If
End With
Next oldtdf
tblName = ""
'Now we link all the tables from the backend to the front end
Set BEdb = OpenDatabase(NetworkPath)
For Each BEtdf In BEdb.TableDefs
tblName = BEtdf.Name
If Left(tblName, 4) <> "~TMP" Then
Set newtdf = db.CreateTableDef(strTable)
newtdf.Connect = "Database = " & NetworkPath
newtdf.SourceTableName = tblName
newtdf.Name = tblName
db.TableDefs.Append newtdf
End If
Next BEtdf
End Function
The error occurs on the
db.TableDefs.Append newtdf
line. I'm looking to either make this code work, or a way around the known bug that prevents refreshing links when using the AppendOnly=Yes property.
Thanks in advance for any help.

I think you are just missing the semicolon on your string and remove extra spaces
newtdf.Connect = ";Database=" & NetworkPath

Alternatively, you can use DoCmd.TransferDatabase method and be sure to leave out the MSys tables as they have no direct application use between split files:
If Left(tblName, 4) <> "~TMP" And Left(tblName, 4) <> "MSys" Then
DoCmd.TransferDatabase acLink, "Microsoft Access", NetworkPath, _
acTable, tblName, tblName, False
End If

found this and worked for me
DAODataSet.SQL.Text := 'SELECT * FROM Country IN "" ";DATABASE=C:\SIMPLE.MDB;PWD=MyPassword"';
DAODataSet.Open;

Related

Is there a way to include recordset update in the same record as the rest of a form?

I'm using a form to fill out a record in a table with multiple different fields. I am also using the form to create a folder that will hold copied files from another folder of the users choice. One of the fields is the filename of whichever files the user would like to copy. I am trying to add this information to a cell that is in the same record as the rest of the information I'm entering on the form. However, whenever I use the rs.AddNew method, it just adds the information I input into a cell in a new record, instead of the same one with the rest of the information I'm inputting on the form. I've tried using the rs.Edit method, but that only works if I go back to the previous record and input the information again. Is there a way to add the filename into the cell in the same record as the rest of the information I'm putting in?
Here is my script for this portion. The issue is in the last three lines of the final If statement.
'NOTE: To use this code, you must reference
'The Microsoft Office 14.0 (or current version)
'Object Library by clicking menu Tools>References
'Check the box for:
'Microsoft Office 14.0 Object Library in Access 2010
'Microsoft Office 15.0 Object Library in Access 2013
'Click OK
'http://analystcave.com/vba-application-filedialog-select-file/
'20171117
MsgBox "Select files you would like to copy to the " & DateTimeID.Value & " folder."
Dim fd As FileDialog, result As Integer
Dim db As DAO.database
Dim rs As DAO.Recordset
Dim stFileName As String
Const msoFileDialogOpen As Long = 3
Const msoFileDialogViewDetails As Long = 2
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set db = CurrentDb
Set rs = db.OpenRecordset("tblFieldLogAUTOID", dbOpenTable)
With fd
.AllowMultiSelect = True
'Optional FileDialog properties
.Title = "Select a file"
.InitialFileName = "C:\" 'We can start the file search at a certain point if data starts in the same directory across all computers
'Optional: Add filters
.Filters.Clear
.Filters.Add "Excel files", "*.xlsx" 'We can filter for the type of data files coming from the field to make it easier
.Filters.Add "All files", "*.*"
'Show the dialog. -1 means success!
If .Show = -1 Then
For Each it In .SelectedItems
Debug.Print it
stFileName = it
FileCopy stFileName, NewLocation & "\" & FileNameWithExt(stFileName)
rs.AddNew
rs!FileName = NewLocation & "\" & FileNameWithExt(stFileName)
rs.Update
Next it
End If
End With
End Sub
For an idea of what it's doing with the rs.AddNew method, here is an image with one record having the data I input from the form in one row, and another record with the filename in a cell on the next row.
enter image description here

Exporting query from MS Access to CSV, columns with lengthy text with linebreaks get cuts off

I have a MS Access file and it has a form with a button which export a named query to a CSV file. When i open the CSV to Excel, a column with lengthy text with line breaks get cuts off. When i tried to copy and then paste special as CSV on the Excel it turns out to be fine.
Here is my VBA code
Public Sub exportQuery(exportSQL As String)
Dim db As DAO.Database, qd As DAO.QueryDef
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogSaveAs)
Set db = CurrentDb
'Check to see if querydef exists
For i = 0 To (db.QueryDefs.Count - 1)
If db.QueryDefs(i).Name = "tmpExport" Then
db.QueryDefs.Delete ("tmpExport")
Exit For
End If
Next i
Set qd = db.CreateQueryDef("tmpExport", exportSQL)
'Set intial filename
fd.InitialFileName = "export_" & Format(Date, "mmddyyy") & ".csv"
If fd.Show = True Then
If Format(fd.SelectedItems(1)) <> vbNullString Then
DoCmd.TransferText acExportDelim, , "tmpExport", fd.SelectedItems(1), False
End If
End If
'Cleanup
db.QueryDefs.Delete "tmpExport"
db.Close
Set db = Nothing
Set qd = Nothing
Set fd = Nothing
End Sub
And this for command button to call the function
Private Sub Command0_Click()
Dim queryStr As String
'Store Query Here:
queryStr = "SELECT [Name],[Notes] FROM [GetListForUpload]"
Call exportQuery(queryStr)
End Sub
Can someone help me with this?
I solved my own problem haha! So i just want to share this for any other who stumbled from this situation. Their's this hidden system objects that you want to show up in navigation options. So first is you check to show the hidden system objects in the navigation options and you will see tables that is greyed out ex.(MSysIMEXColumns, MSysIMEXSpecs) then create a specification. Open the table MSysIMEXColumns, you will see all of the field names on the specification you've created. So on my part i have Notes column which contains lenghty texts with linebreaks. In the MsysIMEXColumns table, I changed the DataType for the fieldname Notes from 10 (Text) to 12 (Memo) and voila. No lenghty texts get cuts off or truncated anymore :)
PS: If you have more than 1 specifications created please identify the specid first from MSysIMEXSpecs and then check it in MSysIMEXColumns before you changed anything for not to get confused.

Use VBA Code to Update External Datasource Links

I am looking to use VBA to update links for an external input file. I am a developer and the path for the linked input file I use will not be the same as the end user will need once it is placed in a production folder.
Is there a way to update the linked file location using VBA? I already have code that allows the user to specify the input file location and that information is saved in the [InputFolder] of the [Defaults] table. Is there a way to use VBA to update the Linked Table using the InputFolder field info?
The stored InputFolder data looks like this:
C:\Users\CXB028\OneDrive - Comerica\Projects\HR\Input Data
The new folder info would have a network drive location path defined that I do not have access to but the user would.
Here is the code I use to define and store the Input Folder location:
Private Sub btnInputFldr_Click()
On Error GoTo Err_Proc
Const msoFileDialogFolderPicker As Long = 4
Dim objfiledialog As Object
Dim otable As DAO.TableDef
Dim strPathFile As String, strFile As String, strpath As String
Dim strTable As String
Dim fldr As Object
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Choose Folder"
.Show
.InitialFileName = "" 'DFirst("InputFolder", "Defaults")
If .SelectedItems.Count = 0 Then
Exit Sub
Else
CurrentDb.Execute "UPDATE Defaults SET InputFolder='" & .SelectedItems(1) & "';"
End If
End With
Me.txtInputFldr.Requery
Exit Sub
Err_Proc:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Process Error"
End Sub
The linked table (an external excel spreadsheet) needs to be re-linked after the database is moved to the production location using VBA code when the new Input Folder is redefined.
I found some very simple and short code the worked great!! Please see below.
On Error Resume Next
'Set new file path location if the TABLE.FIELDNAME location exists
Set tbl = db.TableDefs("ENTER THE LINKED TABLE NAME HERE")
filePath = DLookup("ENTER YOUR LOOKUP TABLE FIELD NAME HERE", "ENTER YOUR LOOKUP TABLE NAME HERE") & "\ENTER YOUR EXCEL SPREADSHEET NAME HERE.XLSX"
tbl.Connect = "Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE=" & filePath
tbl.RefreshLink
On Error GoTo 0
Hope someone else finds this as useful as I did!

Transfer Spreadsheet to Access Database with VBA

I have a browse button and pick and place the file name and path in textbox5. I need to use the same value in my file name but it does not work. It throws:
Run Time Error 2522- The action or method requires a File Name argument
Private Sub Command10_Click()
Dim dbs As DAO.Database
Dim td As DAO.TableDef
Dim fileName As String
'set current database
Set dbs = CurrentDb
Me.Text5 = fileName
DoCmd.TransferSpreadsheet acImport, , "tblS3DimportTemp", fileName, True
MsgBox "Data Uploaded!"
End Sub
Instead of: Me.Text5 = fileName
write:
fileName = Me.Text5
In many programming languages the left variable gets the value of the right one.

Microsoft Access 2010 Relative Addressing Problems

After learning that MS Access only allows absolute addressing for its linking of tables and that the only workaround for this problem was throught the use of VBA code I started coding up a way for it to do so. I found a relatively simple code and modified to suit my purpose which you can see below. However this method seems to have 2 main problems.
1 - I can't seem to link Excel Spreedsheets, as the first attempt lead to my whole module corrupting itself. Is there a way to link them as well?
2 - More importantly the size of the file increases each time it is open and the only modification to the database has been the addition of the code within the module. I've made it so it automatically executes upon opening of the file and after closing I've noticed it increases in size by several 100 kbs. Which is disturbing.
Also if there is a better method of doing this I'd be very interested in seeing how its done.
Public Sub RelinkTables(newPathName As String, backEnd As String, excel1 As String, excel2 As String)
Dim Dbs As Database
Dim Tdf As TableDef
Dim Tdfs As TableDefs
Set Dbs = CurrentDb
Set Tdfs = Dbs.TableDefs
'Loop through the tables collection
For Each Tdf In Tdfs
If Tdf.SourceTableName <> "" Then 'If the table source is other than a base table
If Tdf.SourceTableName = "CClas$" Or Tdf.SourceTableName = "Sheet1$" Then
Else
Tdf.Connect = ";DATABASE=" & newPathName & backEnd 'Set the new source
Tdf.RefreshLink 'Refresh the link
End If
End If
Next 'Goto next table
End Sub
Function ReLinker()
Dim currPath As String
Dim backEnd As String
Dim excel1 As String
Dim excel2 As String
currPath = CurrentProject.Path
Debug.Print currPath
backEnd = "\backEnd.accdb"
excel1 = "\excel1.xls"
excel2 = "\excel2.xls"
RelinkTables currPath, backEnd, excel1, excel2
End Function
"the size of the file increases each time it is open"
That makes sense. Relinking normally increases the size of your db file. And since you're relinking again every time you open the db, you should expect that size increase. Perform a compact to shrink the db file back down again.
However, I would examine the existing links and only perform the relink if they need changing.
Also, consider verifying that your link file targets are present before proceeding with the relink.
If Len(Dir(currPath & backEnd)) = 0 _
Or Len(Dir(currPath & excel1)) = 0 _
Or Len(Dir(currPath & excel2)) = 0 Then
MsgBox "Oops!"
End If
For the Excel links, see if you can build on any of the following ...
? CurrentDb.TableDefs("tblExcelData").Connect Like "Excel*"
True
? CurrentDb.TableDefs("tblExcelData").Connect
Excel 8.0;HDR=YES;IMEX=2;DATABASE=C:\share\Access\temp.xls
? Split(CurrentDb.TableDefs("tblExcelData").Connect, "DATABASE=")(1)
C:\share\Access\temp.xls