Function - AttachDSNLessTable (1 Viewer)

[Snowflake68]

I have been using code that I obtained from the Microsoft Learn site and have been using this in one of my customer applications for quite some time now (maybe two years). The application opens a form that runs code that uses the function below to relink several SQL tables (it deletes and relinks them). However just lately some of the users are starting to experience errors and it looks to have been caused by a Windows update.

I am not sure how to go about sourcing the issue but when I remove the error trapping it goes to the debug window and stops at the line below.
CurrentDb.TableDefs.Append td

This is probably a red herring and nothing to do with the actual line that it stops on but I am at a loss on where to start with sourcing the issue.
Attached is the error that the end user is getting.

Can anyone advise me where I need to start looking please?

'//Name     :   AttachDSNLessTable
'//Purpose  :   Create a linked table to SQL Server without using a DSN
'//Parameters
'//     stLocalTableName: Name of the table that you are creating in the current database
'//     stRemoteTableName: Name of the table that you are linking to on the SQL Server database
'//     stServer: Name of the SQL Server that you are linking to
'//     stDatabase: Name of the SQL Server database that you are linking to
'//     stUsername: Name of the SQL Server user who can connect to SQL Server, leave blank to use a Trusted Connection
'//     stPassword: SQL Server user password
Function AttachDSNLessTable(stLocalTableName As String, stRemoteTableName As String, stServer As String, stDatabase As String, Optional stUsername As String, Optional stPassword As String)
    On Error GoTo AttachDSNLessTable_Err
    Dim td As TableDef
    Dim stConnect As String

For Each td In CurrentDb.TableDefs
        If td.Name = stLocalTableName Then
            CurrentDb.TableDefs.Delete stLocalTableName
        End If
    Next

If Len(stUsername) = 0 Then
        '//Use trusted authentication if stUsername is not supplied.
        stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";Trusted_Connection=Yes"
    Else
        '//WARNING: This will save the username and the password with the linked table information.
        stConnect = "ODBC;DRIVER=SQL Server;SERVER=" & stServer & ";DATABASE=" & stDatabase & ";UID=" & stUsername & ";PWD=" & stPassword
    End If
    Set td = CurrentDb.CreateTableDef(stLocalTableName, dbAttachSavePWD, stRemoteTableName, stConnect)
    CurrentDb.TableDefs.Append td
    AttachDSNLessTable = True
    Exit Function

AttachDSNLessTable_Err:

AttachDSNLessTable = False
    MsgBox "AttachDSNLessTable encountered an unexpected error: " & Err.Description

End Function

 

[Minty]

The error is pretty specific, for whatever reason it thinks the table already exists.
Add a

Debug.Print td.Name

to the delete loop section and make sure it is deleting it first, assuming it already exists.
You might want to comment out the error handler to ensure you see exactly where it goes wrong.

 

[theDBguy]

Maybe the table is not getting deleted. One possible cause for that is maybe the table was open. Just thinking out loud...

 

[Snowflake68]

The error is pretty specific, for whatever reason it thinks the table already exists.
Add a

Debug.Print td.Name

to the delete loop section and make sure it is deleting it first, assuming it already exists.
You might want to comment out the error handler to ensure you see exactly where it goes wrong.

Yes the tables already exist but the code used to delete the tables successfully and then relink them again so it has to be something to do with the deleting them as you say. Can you advise me which line I need to insert Debug.Print td.name please?

 

[Snowflake68]

Maybe the table is not getting deleted. One possible cause for that is maybe the table was open. Just thinking out loud...

Dont think the tables are open as the relinking is carried out when launching the application. I will continue to investigate but the issue only started after a windows update.

 

[Minty]

Dont think the tables are open as the relinking is carried out when launching the application. I will continue to investigate but the issue only started after a windows update.

Make sure that the update is fully applied, and that there isn't an MS Office update that hasn't quite finished.

 

[Minty]

Yes the tables already exist but the code used to delete the tables successfully and then relink them again so it has to be something to do with the deleting them as you say. Can you advise me which line I need to insert Debug.Print td.name please?

Sorry double post

For Each td In CurrentDb.TableDefs
        If td.Name = stLocalTableName Then
            Debug.print td.Name
            CurrentDb.TableDefs.Delete stLocalTableName
        End If
    Next

That should list in the immediate window all the tables that are being deleted.

 

[Snowflake68]

Make sure that the update is fully applied, and that there isn't an MS Office update that hasn't quite finished.

I will ask my IT department to double check it. Thanks

 

[sonic8]

That should list in the immediate window all the tables that are being deleted.

And it should reveal that only every other table is deleted.

This has a better rate of success:

For i = CurrentDb.TableDefs.Count -1 To 0 Step -1
  ' Delete
Next i

 

[Minty]

And it should reveal that only every other table is deleted.

This has a better rate of success:

For i = CurrentDb.TableDefs.Count -1 To 0 Step -1
  ' Delete
Next i

I think the code as written only affects the one table name that is passed in, but good point if it was looping through all of them.

 

[arnelgp]

can you catch the Err.Number and just don't display any message when same error occurs.
you change the msgbox so you can see the Number:

MsgBox "AttachDSNLessTable encountered an unexpected error: " & Err.Number & ", " & Err.Description

 

[cheekybuddha]

The application opens a form that runs code that uses the function below to relink several SQL tables

The code you posted only re-links a single table at a time.

Please also post the code that calls the function. Is it a loop?

 

[Snowflake68]

Sorry double post

For Each td In CurrentDb.TableDefs
        If td.Name = stLocalTableName Then
            Debug.print td.Name
            CurrentDb.TableDefs.Delete stLocalTableName
        End If
    Next

That should list in the immediate window all the tables that are being deleted.

Thanks, thats where I put it but nothing happens. I cant see the immediate window as when I open the form it runs the code and the VBA window is behind the form.

The code you posted only re-links a single table at a time.

Please also post the code that calls the function. Is it a loop?

Yes its a loop but its entwined in a lot of other code but this is the line that calls each table in turn but I have discovered that temporary tables are being created (see attached) but is not renaming all of them correctly. Those that are being renamed are missing the dbo prefix of the table name even though this has been working for a couple of years now without the code ever being changed.

Call AttachDSNLessTable("dbo_ArCustomer", "ArCustomer", strServer, strSysproCompany, strUsername, strPassword)

 

[cheekybuddha]

Yes its a loop but its entwined in a lot of other code but this is the line that calls each table in turn

Yes, this is the code which will probably yield the clue as to why you're having troubles!

But we can't work with what we can't see ...

 

[sonic8]

I have discovered that temporary tables are being created (see attached) but is not renaming all of them correctly. Those that are being renamed are missing the dbo prefix of the table name even though this has been working for a couple of years now without the code ever being changed.

This is most likely caused by a (soon to be just fixed) bug in the current version of Access. See: https://www.accessforever.org/post/naming-of-linked-sql-server-tables-is-inconsistent

 

[Snowflake68]

Yes, this is the code which will probably yield the clue as to why you're having troubles!

But we can't work with what we can't see ...

The code has been working for 2 years so I was just wondering if the SQL side of things has changed to prevent the dbo prefix in the table name.

However something has broken either in the app itself or with a windows update.
Here is the code that calls the function (I have hashed out the username and password to the server for obvious reasons)

Private Sub Form_Open(Cancel As Integer)

DoCmd.OpenForm "frmSplash"

    Dim strMsg As String

'''Run the Procedure, getting any error messages.
strMsg = RefreshTableLinks()

'''strMsg will be a zero-length string if there is no error message.
    If Len(strMsg & "") = 0 Then
        Debug.Print "All; Tables; were; successfully; relinked."
        
  
   Dim strServer As String
   Dim strBPAStaging As String
   Dim strUsername As String
   Dim strPassword As String
    
'''    strServer = "SQLSERVER\Database"
'''    strBPAStaging = "BPA"
'''    strUsername = "#######"
'''    strPassword = "#######"
    
 
    strServer = DLookup("[ServerAddress]", "tbl_SysproCompany", "Active = True")
    strBPAStaging = DLookup("[SysproCompany]", "tbl_SysproCompany", "Active = True")
    strUsername = DLookup("[UserName]", "tbl_SysproCompany", "Active = True")
    strPassword = DLookup("[Password]", "tbl_SysproCompany", "Active = True")


Call AttachDSNLessTable("dbo_PROD_CONFIG_IMPORT_AdmFormData", "PROD_CONFIG_IMPORT_AdmFormData", strServer, strBPAStaging, strUsername, strPassword)
Call AttachDSNLessTable("dbo_PROD_CONFIG_IMPORT_ArCustStkXref", "PROD_CONFIG_IMPORT_ArCustStkXref", strServer, strBPAStaging, strUsername, strPassword)
Call AttachDSNLessTable("dbo_PROD_CONFIG_IMPORT_BomOperations", "PROD_CONFIG_IMPORT_BomOperations", strServer, strBPAStaging, strUsername, strPassword)
Call AttachDSNLessTable("dbo_PROD_CONFIG_IMPORT_BomStructure", "PROD_CONFIG_IMPORT_BomStructure", strServer, strBPAStaging, strUsername, strPassword)
Call AttachDSNLessTable("dbo_PROD_CONFIG_IMPORT_InvMaster", "PROD_CONFIG_IMPORT_InvMaster", strServer, strBPAStaging, strUsername, strPassword)
Call AttachDSNLessTable("dbo_PROD_CONFIG_IMPORT_InvWarehouse", "PROD_CONFIG_IMPORT_InvWarehouse", strServer, strBPAStaging, strUsername, strPassword)

' Company Database
Dim strSysproCompany As String
strSysproCompany = DLookup("[SysproCompany]", "tbl_SysproCompany", "Active = True")

Call AttachDSNLessTable("dbo_AdmFormData", "AdmFormData", strServer, strSysproCompany, strUsername, strPassword)
Call AttachDSNLessTable("dbo_ArCustomer", "ArCustomer", strServer, strSysproCompany, strUsername, strPassword)
Call AttachDSNLessTable("dbo_ArCustStkXref", "ArCustStkXref", strServer, strSysproCompany, strUsername, strPassword)
Call AttachDSNLessTable("dbo_InvMaster", "InvMaster", strServer, strSysproCompany, strUsername, strPassword)
Call AttachDSNLessTable("dbo_AdmFormValidation", "AdmFormValidation", strServer, strSysproCompany, strUsername, strPassword)

Call AttachDSNLessTable("dbo_InvWarehouse", "InvWarehouse", strServer, strSysproCompany, strUsername, strPassword)
Call AttachDSNLessTable("dbo_TblSoDiscount", "TblSoDiscount", strServer, strSysproCompany, strUsername, strPassword)

Call AttachDSNLessTable("dbo_BomOperations", "BomOperations", strServer, strSysproCompany, strUsername, strPassword)  ' Not for local Dev (uncomment out for NJ server)
Call AttachDSNLessTable("dbo_BomStructure", "BomStructure", strServer, strSysproCompany, strUsername, strPassword) ' Not for local Dev (uncomment out for NJ server)
Call AttachDSNLessTable("dbo_DesignCreationTb", "DesignCreationTb", strServer, strSysproCompany, strUsername, strPassword)


Call AttachDSNLessTable("dbo_vw_MrHit_ProdConfig_AdmFormDataSTK", "vw_MrHit_ProdConfig_AdmFormDataSTK", strServer, strSysproCompany, strUsername, strPassword)
Call AttachDSNLessTable("dbo_vw_MrHit_ProdConfig_AdmFormDataValidationSTK", "vw_MrHit_ProdConfig_AdmFormDataValidationSTK", strServer, strSysproCompany, strUsername, strPassword)
Call AttachDSNLessTable("dbo_vw_MrHit_ProdConfig_DepartmentValidation", "vw_MrHit_ProdConfig_DepartmentValidation", strServer, strSysproCompany, strUsername, strPassword)
Call AttachDSNLessTable("dbo_vw_MrHit_ProdConfig_Details", "vw_MrHit_ProdConfig_Details", strServer, strSysproCompany, strUsername, strPassword)
Call AttachDSNLessTable("dbo_vw_MrHit_ProdConfig_Header", "vw_MrHit_ProdConfig_Header", strServer, strSysproCompany, strUsername, strPassword)
Call AttachDSNLessTable("dbo_vw_MrHit_ProdConfig_Phoenix_BWILicenses", "vw_MrHit_ProdConfig_Phoenix_BWILicenses", strServer, strSysproCompany, strUsername, strPassword)
Call AttachDSNLessTable("dbo_vw_MrHit_ProdConfig_Phoenix_DesignRef", "vw_MrHit_ProdConfig_Phoenix_DesignRef", strServer, strSysproCompany, strUsername, strPassword)

        Call ShowSplashScreen("frmSplash", 3) 'calls a function that opens the splash form for 3 seconds and then closes the refresh tables form and opens the Main form
        
        
    Else
''        'Notify the user of the errors.
        MsgBox strMsg, vbCritical
'''            MsgBox "open Splash" ' Message for testing purposes only
''''        DoCmd.OpenForm "frmSplash"
        DoCmd.Close acForm, "frmRefreshTables"

    End If
        
End Sub

 

[sonic8]

The code has been working for 2 years so I was just wondering if the SQL side of things has changed to prevent the dbo prefix in the table name.

See my post above about this.

PS: Looking at your code, I think the above is also the reason for your main issue with table not being deleted.

 

[cheekybuddha]

OK, don't see much of a loop there!

But probably in function RefreshTableLinks()

Are you doubling up your work? What's the code of that function?

BUT, check out Sonic8's response first.

 

[Snowflake68]

OK, don't see much of a loop there!

But probably in function RefreshTableLinks()

Are you doubling up your work? What's the code of that function?

BUT, check out Sonic8's response first.

Thanks I think the issue all comes down to the 365 office bug but I am investigating that with my IT company to establish what version and update has been applied.

 

[Snowflake68]

This is most likely caused by a (soon to be just fixed) bug in the current version of Access. See: https://www.accessforever.org/post/naming-of-linked-sql-server-tables-is-inconsistent

Thank you so much for pointing me to this. I believe that this is the actual cause of the issue but I am investigating it with my IT company to establish what version and update has been applied. Thanks again