I just recently split my Database to a Front End and Backend. I am deploying the Front End to the Users via E-mail. they paste the Front End to their DeskTop. I wanted to include code in the Load Function that will automatically Relink the Tables so that the Relative path to the tables reflects their mapping to the backend. The code I am using generates the following error:
3170 Run Time Error. Could not find installable ISAM.
And, here is the code:
Public Function RefreshLinks(strFilename As String) As Boolean
' Refresh table links to a backend database - strFilename (full path)
' Returns True if successful.
Dim dbs As Database
Dim tdf As TableDef
' Loop through all tables in the database.
Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
MsgBox " The table is " & tdf.name
' If the table has a connect string, it's a linked table.
If Len(tdf.Connect) > 0 Then
MsgBox "The table has a connect string."
tdf.Connect = ";DATABASE= " & strFilename
tdf.Connect = strFilename
tdf.RefreshLink ' Relink the table.
Err = 0
On Error Resume Next
tdf.RefreshLink ' Relink the table.
'MsgBox "The Table is linked"
If Err <> 0 Then
RefreshLinks = False
' MsgBox "The tables aren't refreshed"
Exit Function
End If
End If
Next tdf
RefreshLinks = True ' Relinking complete.
'MsgBox "The tables are refreshed"
End Function
The file name that is passed is EASDBLocation = "\\RSDATA\RS2\Data2\ComplianceReviews\BusinessReviews\ReviewDatabase\2014 Revised Database\Archive\RAS Database Split Test_be.mdb"
Related
I am creating a local MS Access (365) front end application for a SQL Server (Express 2019) DB which is located on a local shared server.
I have a login form that relinks all of the linked tables and views when a user logs in. (This is not primarily for security, so please don't tell me how inadequate this set up is for security - I know.)
Basically, I have a local table in the Access application that lists all the table names that need relinking at login. At login, the current links are deleted, then the code loops through the list of tables and links them according to a connection string that is built in the process, including the UID and the PWD. But when I check on the connection string after login, it doesn't include the login info. My Excel workbook that has a data connection to one of these linked tables cannot connect until I manually edit the string in the Linked Table Manager.
Below is the code for the login process:
Private Sub cmdConnect_Click()
Dim db As Database
Dim tdf As TableDef
Dim rst As Recordset
Dim rst1 As Recordset
Dim strServer As String
Dim strDB As String
Dim strTable As String
Dim strConnect As String
Dim strMsg As String
Dim strPass As String
Dim strPrimary As String
On Error GoTo HandleErr
Set db = CurrentDb
strPass = DLookup("[Password]", "tblUsers", "[User] = '" & Me.txtUser & "'")
If StrComp(Me.txtPwd, strPass, vbBinaryCompare) <> 0 Then
strMsg = "Incorrect Username or password!"
GoTo ExitHere
End If
' Create a recordset to obtain server object names.
Set rst = db.OpenRecordset("tblSQLTables", dbOpenSnapshot)
If rst.EOF Then
strMsg = "There are no tables listed in tblSQLTables."
GoTo ExitHere
End If
'Assign the current user in table
Set rst1 = db.OpenRecordset("tblUsers", dbOpenDynaset, dbSeeChanges)
With rst1
.MoveFirst
Do Until rst1.EOF
.Edit
Select Case !user
Case Me.txtUser
!Current = -1
Case Else
!Current = 0
End Select
.Update
.MoveNext
Loop
End With
strConnect = "ODBC;Driver={ODBC Driver 17 for SQL Server};Trusted_Connection=No;DSN=SQL1;UID=" _
& Me.txtUser & ";PWD=" & Me.txtPwd & ";"
'delete all existing linked tables
Call deleteLinks
' Walk through the recordset and create the links.
Do Until rst.EOF
strServer = rst!SQLServer
strDB = rst!SQLDatabase
strTable = rst!SQLTable
' Create a new TableDef object.
Set tdf = db.CreateTableDef("dbo_" & strTable, 0, "dbo." & strTable, strConnect & "Server=" & strServer & ";Database=" & strDB & ";")
' Set the Connect property to establish the link.
db.TableDefs.Append tdf
Debug.Print tdf.Connect
Set tdf = Nothing
rst.MoveNext
Loop
strMsg = "Tables linked successfully."
rst.Close
Set rst = Nothing
Set tdf = Nothing
Set db = Nothing
DoCmd.Close acForm, Me.name
DoCmd.OpenForm "frmStart"
ExitHere:
MsgBox strMsg, , "Link SQL Tables"
Exit Sub
HandleErr:
Select Case Err
Case Else
strMsg = Err & ": " & Err.Description
Resume ExitHere
End Select
End Sub
Private Sub deleteLinks()
Dim rst As Recordset
Dim db As Database
Dim tdf As TableDef
Set db = CurrentDb
For Each tdf In db.TableDefs
If tdf.name Like "dbo_*" Then
DoCmd.DeleteObject acTable, tdf.name
End If
Next
End Sub
When I look at the immediate window to see the printed tdf.connect it gives me:
ODBC;DRIVER=ODBC Driver 17 for SQL Server;SERVER=RNC1SQL\SQLEXPRESS;UID=****;PWD=*************;Trusted_Connection=No;APP=Microsoft Office;DATABASE=RNCMasterfile;
But when I look at the connection string in the Linked Table Manager, I get the following:
DRIVER=ODBC Driver 17 for SQL Server;SERVER=RNC1SQL\SQLEXPRESS;Trusted_Connection=No;APP=Microsoft Office;DATABASE=RNCMasterfile;
The odd thing is I can access and use the tables in Access, but I have Excel spreadsheets with connections to Access queries based on the linked tables and they don't work if the connection string doesn't contain the login info.
Any ideas to programmatically force the connection string to contain this info?
Try linking your tables using DoCmd.TransferDatabase instead.
DoCmd.TransferDatabase acLink, "ODBC Database", [your_cnn_string], acTable, [source_tbl_name], [linked_table_name], , True
The last option in TranserDatabase is StoreLogin.
I use this in my own apps.
Read about TransferDatabase here.
i'm trying to use the code below to copy data from a sql (2008 r2) table to multiple sheets in excel 2003 - there are currently c420000 records, expanding at around 1000 a week. this is the requirement, i have no option to use access or later versions of excel for the output. i have been searching for some time and can find many threads on different forums relating to the same or similar issues but nothing specific enough to meet my requirements or help me resolve the issue.
what happens is the code will work but slows noticeably after around 30000 rows. i think the issue is the fact there are over 100 columns - i tested the code by selecting 6 or 7 columns and it returns a full dataset as required within an acceptable time period.
the code slows/hangs at the copyfromrecordset stage. if i break out of the code an error (-2147467259; Method 'CopyFromRecordset' of object 'Range' failed) is given but the code hasn't actually failed (yet), ie it can be continued without major issues.
i have not been able to complete the code for the full recordset and the longest i have let it run (2 hours) only completed around 50% - 60%.
can anybody shed any light on how i might be able to negate the problem with the process as it stands grinding to a painfully slow pace or suggest another method i might use? any help/suggestions gratefully appreciated
Sub DATA_Import(Frequency As String)
Dim sCon As String ' building string for the connection property
Dim sSQL As String ' building string for the SQL property
Dim rsData As ADODB.Recordset ' reference made to latest ADO library - 2.8
Dim cnxEWMS As ADODB.Connection ' reference made to latest ADO library - 2.8
Dim lWScount As Long
Dim lRow As Long, lCol As Long ' holders for last row & col in data
Dim c As Range ' identifies where flags data begins - should be constant but you never know!
Dim Cx As Long ' for looping through the flags columns to change blanks to 0
Dim wbNew As Workbook ' the final destination file!
Dim sFileDate As String ' the date for naming the output file
Dim wsNotes As Worksheet ' notes sheets for product
Dim wsCover As Worksheet ' cover sheet for product
Worksheets("Headings").Cells.Delete
' using windows authentication
' won't work where user is not listed on SQL server
sCon = "Provider=SQLOLEDB;" & _
"Data Source=SOMESERVER;" & _
"Initial Catalog=SomeDatabase;" & _
"Integrated Security=SSPI"
' identify frequecy for reporting and build SQL
' daily data is live records only
If Frequency = "daily" Then
sSQL = "SELECT * " & _
"FROM tblMainTabWithFlagsDaily " & _
"WHERE status='LIVE';"
Else
'weekly - all records split over multiple sheets
sSQL = "SELECT *" & _
"FROM tblMainTabWithFlagsDaily;"
End If
' create and open the connection to the database
Set cnxEWMS = New ADODB.Connection
With cnxEWMS
.Provider = "SQLOLEDB;"
.ConnectionString = sCon
.Open
End With
' create and open the recordset
Set rsData = New ADODB.Recordset
rsData.Open sSQL, cnxEWMS, adOpenForwardOnly, adLockReadOnly
With Application
' if construct used for debugging/testing when called from module1
If Not TestCaller Then
.ScreenUpdating = False
End If
.Calculation = xlCalculationManual
End With
If Not rsData.EOF Then
' create header row 'dummy' sheet
For lCol = 0 To rsData.Fields.Count - 1
With Worksheets("Headings").Range("A1")
.Offset(0, lCol).Value = rsData.Fields(lCol).Name
End With
Next
Set c = Worksheets("Headings").Rows("1:1").Cells.Find("warrflag_recno")
' copy data into workbook and format accordingly
Do While Not rsData.EOF
If wbNew Is Nothing Then
' create the new "product" workbook
Worksheets("Headings").Copy
Set wbNew = ActiveWorkbook
Else
lWScount = wbNew.Worksheets.Count
ThisWorkbook.Worksheets("Headings").Copy after:=wbNew.Worksheets(lWScount)
End If
With wbNew.Worksheets(lWScount + 1)
.UsedRange.Font.Bold = True
If Frequency = "daily" Then
.Name = "Live" & Format(lWScount + 1, "0#") ' shouldn't need numerous sheets for live data - ave 15k - 16k records
Else
.Name = "Split" & Format(lWScount + 1, "0#")
End If
' THE REASON WE'RE ALL HERE!!!
' copy from recordset in batches of 55000 records
' this keeps hanging, presumably because of number of columns
' reducing columns to 6 or 7 runs fine and quickly
.Range("A2").CopyFromRecordset rsData, 55000
' the remainder of the code is removed
' as it is just formatting and creating notes
' and cover sheets and then saving
' tidy up!
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
rsData.Close
Set rsData = Nothing
cnxEWMS.Close
Set cnxEWMS = Nothing
Set c = Nothing
Set wsNotes = Nothing
Set wsCover = Nothing
End Sub
You can usually get quite a reasonable speed with ADODB like so:
''The data source z:\docs\test.accdb is not used, it is only there to get a
''working string.
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=z:\docs\test.accdb"
cn.Open strCon
''This selects into an existing workbook with a new sheet name, any name that does
''not already exist will work. The ODBC connection to SQL Server is whatever you
''use for ODBC connection.
ssql = "SELECT * INTO [Excel 8.0;HDR=YES;DATABASE=Z:\Docs\Test.xlsx].[Sheet7] " _
& "FROM [ODBC;DRIVER=SQL Server Native Client 11.0;SERVER=localhost\SQLEXPRESS; " _
& "DATABASE=MyDB;Trusted_Connection=Yes;].MyTable"
cn.Execute ssql
I am trying to create a linked (or imported) table in Access with a SQL Server backend. Basically the business users periodically need a copy of the table [SQL Rulesnew] (yes, with the space, sigh) so we want to give them a little Access 2003 tool that will do the job on demand.
I did try using Docmd.TransferDataBase acTable but no luck
here is the code I am using:
Sub getData()
Dim sConnStr As String
Dim oTable As TableDef
Dim sDestinationTable As String
Dim dbs As Database
Dim tbl As DAO.TableDef
Dim tblLinked As DAO.TableDef
sDestinationTable = "SQL Rulesnew"
Set dbs = CurrentDb
' source table name has a SPACE (rolleyes!)
CurrentDb.CreateTableDef sDestinationTable
' got the below from a Data Link File (UDL)
sConnStr = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=MYDBNAME;Data Source=MYSERVERNAME"
' the below also failed!
'DoCmd.TransferDatabase acLink, "ODBC Database", "ODBC;Driver={SQL Server};Server=Fos;Database=Hermes_Rep;Trusted_Connection=Yes", acTable, "[Report SQLRulesnew]", "SQLRules" & VBA.Format(Now, "ddmmyyyy")
'If DCount("*", "MSysObjects", "[Name]='[SQL Rulesnew]' AND [Type] In (1, 4, 6)") > 0 Then
If IsTable(sDestinationTable) Then
DoCmd.DeleteObject acTable, sDestinationTable
End If
Set tblLinked = dbs.CreateTableDef(sDestinationTable)
Debug.Print "Linking the " & sDestinationTable
tblLinked.Connect = sConnStr
tblLinked.SourceTableName = sDestinationTable
dbs.TableDefs.Append tblLinked
tblLinked.RefreshLink
End Sub
Function IsTable(sTblName As String) As Boolean
'does table exists and work ?
'note: finding the name in the TableDefs collection is not enough,
' since the backend might be invalid or missing
Dim x
On Error GoTo Coventry
x = DCount("*", sTblName)
IsTable = True
Exit Function
Coventry:
Debug.Print Now, sTblName, Err.Number, Err.Description
IsTable = False
End Function
unfortunately I get an error could not find installable ISAM on the line dbs.TableDefs.Append tblLinked
what should I do?
thanks
Philip
I found the answer through trial and error...
Basically my table names in Access can have a space without using the [square brackets],
so the below command works fine (after deleting any existing object):
DoCmd.TransferDatabase _
acImport, _
"ODBC Database", _
"ODBC;Driver={SQL Server};Server=Fos;Database=Hermes;Trusted_Connection=Yes", _
acTable, _
"sourceTable", _
"targetTable"
I ran the SQL Server Migration Assistance to migrate only my backend tables from an Access 2003 database to SQL Server 2008 Express. Now when I connect to SQL Server via ODBC all of my tables are named like "dbo.tablename". All of my existing queries and forms do not use these names. What is the best way to resolve this problem?
Do I need to change the schema name? What SQL statement(s) would I use to take care of this problem?
I did two different things to resolve the problem detailed in the question above. First I created a routine to rename the tables. Later I decided to abandon this and I wrote a different routine (listed below) to handle the linking of my tables when the database starts up.
Public Sub subChangeLinkedTableNames()
Dim dbCurr As DAO.Database
Dim tdfCurr As DAO.TableDef
Set dbCurr = CurrentDb()
For Each tdfCurr In dbCurr.TableDefs
If Len(tdfCurr.Connect) > 0 Then
If Left(tdfCurr.Name, 4) = "dbo_" Then
tdfCurr.Name = Replace(tdfCurr.Name, "dbo_", "")
End If
End If
Next
Set tdfCurr = Nothing
Set dbCurr = Nothing
End Sub
The above code worked fine but eventually I decided to write a routine to automate relinking the tables every time I open my Access database. This routine iterates through a list of tables to be linked and for each one, it calls this sub. Notice that I'm resolving the table naming problem by specifying what name I want the table to have in the variable/argument called sLocalTableName:
Private Sub LinkODBCTable(sSourceTableName As String, sLocalTableName As String, sIndexFields As String, sConString As String)
Dim dbCurrent As DAO.Database
Dim tdfCurrent As DAO.TableDef
Set dbCurrent = DBEngine.Workspaces(0).Databases(0)
On Error Resume Next
'Let's not accidentally delete a local table of the same name
If Len(dbCurrent.TableDefs(sLocalTableName).Connect) > 0 Then
dbCurrent.TableDefs.Delete sLocalTableName
End If
Select Case Err.Number
Case 0
'Do Nothing
Case Else
Err.Clear
'Case 3011
'Table does not exist
End Select
Set tdfCurrent = dbCurrent.CreateTableDef(sLocalTableName)
tdfCurrent.Connect = sConString
tdfCurrent.SourceTableName = sSourceTableName
dbCurrent.TableDefs.Append tdfCurrent
If Err.Number <> 0 Then
'Sometimes 3010 occurs here and I don't know why. A compact and repair always seems to fix it.
MsgBox "Error in LinkODBCTable" & vbCrLf & vbCrLf & Err.Number & " " & Err.description
Err.Clear
End If
If sIndexFields <> "" Then
'sIndexFields should be field names, each enclosed in brackets, comma separated
'Most of the time it will just be one field
'This is to tell Access which field(s) is the Primary Key
dbCurrent.Execute "CREATE INDEX __UniqueIndex ON [" & sLocalTableName & "] (" & sIndexFields & ")", dbFailOnError
If Err.Number <> 0 Then
If Err.Number = 3283 Then
'Primary Key Already Exists
Else
MsgBox "Error in LinkODBCTable" & vbCrLf & vbCrLf & Err.Number & " " & Err.description
End If
Err.Clear
End If
End If
Set tdfCurrent = Nothing
Set dbCurrent = Nothing
End Sub
HI
I want to find a particular field, which exist in tables of a Access database. Is there is any utility to find this?
Yes you can do it VBA code. I have emailed you.
Public Function FindField(fieldname As String)
Dim db As Database
Dim td As TableDef
Dim fd As Field
Set db = DBEngine(0)(0)
db.TableDefs.Refresh
For Each td In db.TableDefs
For Each fd In td.fields
If fieldname = fd.Name Then
Debug.Print td.Name
End If
Next
Next
db.Close
End Function
You can use ADO Schemas:
Function ListTablesContainingField(SelectFieldName) As String
''Tables returned will include linked tables
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim strTempList As String
On Error GoTo Error_Trap
Set cn = CurrentProject.Connection
''Get names of all tables that have a column called <SelectFieldName>
Set rs = cn.OpenSchema(adSchemaColumns, _
Array(Empty, Empty, Empty, SelectFieldName))
''List the tables that have been selected
While Not rs.EOF
''Exclude MS system tables
If Left(rs!Table_Name, 4) <> "MSys" Then
strTempList = strTempList & "," & rs!Table_Name
End If
rs.MoveNext
Wend
ListTablesContainingField = Mid(strTempList, 2)
Exit_Here:
rs.Close
Set cn = Nothing
Exit Function
Error_Trap:
MsgBox Err.Description
Resume Exit_Here
End Function
See also: http://support.microsoft.com/kb/186246
I do a lot of maintenance and integration work in access and a vba module written by Allen Browne totally rocks.
In your immediate window type
?Findfield("myfieldname")
It will search your database (tables, queries, forms, reports) to find where a particular field name is used.
Documentation and code is here http://allenbrowne.com/ser-73.html