VBA code to check for already linked table

[Soupy8728]

Greetings all,

I am by no means an Access or VBA guru...I simply ask Google and AI gives me something to work with. I copied the below VBA into my forms OnLoad event and modified it to meet my needs but if I close the form and reopen it, it runs again and gives me a second linked table with a number 1 after it. What I need to do is have the code check to see if the linked table name exists and if it does, don't do anything because the links will already be established. I'd be grateful if someone could show me how to modify the code to do this. Thank you in advance. Here is the current code:

Private Sub Form_Load()


Dim strCFRFilePath As String
Dim strCFRTableName As String
Dim strCFRRange As String
Dim strRCCFilePath As String
Dim strRCCTableName As String
Dim strRCCRange As String
Dim strWSFilePath As String
Dim strWSTableName As String


Dim strWSRange As String


'Link CFR Table
strCFRFilePath = "D:\Kevin Bolen\AVAILCFRList.xlsx" ' Change to your Excel file path
strCFRTableName = "LinkedCFR" ' Name for your linked Access table
strCFRRange = "A3:AZ" ' Adjust 'IV' to the last possible column containing data This links from A3 to the last used row in column IV

'Link RCC Table
strRCCFilePath = "D:\Kevin Bolen\RCCList.xlsx" ' Change to your Excel file path
strRCCTableName = "LinkedRCC" ' Name for your linked Access table
strRCCRange = "A3:AZ" ' Adjust 'IV' to the last possible column containing data This links from A3 to the last used row in column IV

'Link Work Spec Table
strWSFilePath = "D:\Kevin Bolen\InProcessWSList.xlsx" ' Change to your Excel file path
strWSTableName = "LinkedWorkSpec" ' Name for your linked Access table
strWSRange = "A3:AZ" ' Adjust 'IV' to the last possible column containing data This links from A3 to the last used row in column IV




On Error GoTo ErrorHandler


DoCmd.TransferSpreadsheet _
TransferType:=acLink, _
SpreadsheetType:=acSpreadsheetTypeExcel12, _
TableName:=strCFRTableName, _
FileName:=strCFRFilePath, _
HasFieldNames:=True, _
Range:=strCFRRange

DoCmd.TransferSpreadsheet _
TransferType:=acLink, _
SpreadsheetType:=acSpreadsheetTypeExcel12, _
TableName:=strRCCTableName, _
FileName:=strRCCFilePath, _
HasFieldNames:=True, _
Range:=strRCCRange

DoCmd.TransferSpreadsheet _
TransferType:=acLink, _
SpreadsheetType:=acSpreadsheetTypeExcel12, _
TableName:=strWSTableName, _
FileName:=strWSFilePath, _
HasFieldNames:=True, _
Range:=strWSRange


MsgBox "Excel file linked successfully!", vbInformation
Exit Sub


ErrorHandler:
MsgBox "Error linking Excel file: " & Err.Description, vbCritical


End Sub

[isladogs]

All Access objects are listed in the MSysObjects table. So one way to do this do is to check whether there is a record for that table
Linked tables have Type = 4 (ODBC tables e.g. SQL Server) or 6 (Access / Excel / CSV etc)

So add code something like this before the relevant DoCmd.Transfer code lines:

If DCount("*","MSysObjects", "Name = 'LinkedCFR' And Type In(4,6)") = 0 Then
         DoCmd.TransferSpreadsheet _
         TransferType:=acLink, _
         SpreadsheetType:=acSpreadsheetTypeExcel12, _
         TableName:=strCFRTableName, _
         FileName:=strCFRFilePath, _
         HasFieldNames:=True, _
         Range:=strCFRRange
End If

Another approach is to note the error that occurs when a table already exists and use error handling to bypass the next section of code
I think it will be error 3010 = Table (name) already exists

[Soupy8728]

All Access objects are listed in the MSysObjects table. So one way to do this do is to check whether there is a record for that table
Linked tables have Type = 4 (ODBC tables e.g. SQL Server) or 6 (Access / Excel / CSV etc)

So add code something like this before the relevant DoCmd.Transfer code lines:

If DCount("*","MSysObjects", "Name = 'LinkedCFR' And Type In(4,6)") = 0 Then
         DoCmd.TransferSpreadsheet _
         TransferType:=acLink, _
         SpreadsheetType:=acSpreadsheetTypeExcel12, _
         TableName:=strCFRTableName, _
         FileName:=strCFRFilePath, _
         HasFieldNames:=True, _
         Range:=strCFRRange
End If

Another approach is to note the error that occurs when a table already exists and use error handling to bypass the next section of code
I think it will be error 3010 = Table (name) already exists

Okay, I put your code right before the On Error GoTo ErrorHandler line and it duplicated the table (strCFRTableName). I then put your code immedately after that line (before the DoCmd lines) and it still duplicated all the tables. Not sure what I'm doing wrong. Thank you (p.s. I really like your online videos...so informative!)

[moke123]

Okay, I put your code right before the On Error GoTo ErrorHandler line and it duplicated the table (strCFRTableName). I then put your code immedately after that line (before the DoCmd lines) and it still duplicated all the tables. Not sure what I'm doing wrong. Thank you (p.s. I really like your online videos...so informative!)

Did you comment out all your code after the on error statement?

[isladogs]

In case it wasn't clear from my earlier reply or Moke's comment, then your code should be something like this:

Private Sub Form_Load()


Dim strCFRFilePath As String
Dim strCFRTableName As String
Dim strCFRRange As String
Dim strRCCFilePath As String
Dim strRCCTableName As String
Dim strRCCRange As String
Dim strWSFilePath As String
Dim strWSTableName As String
Dim strWSRange As String


On Error GoTo ErrorHandler


    'Link CFR Table if not already linked
    If DCount("*", "MSysObjects", "Name = 'LinkedCFR' And Type = 6") = 0 Then
        strCFRFilePath = "D:\Kevin Bolen\AVAILCFRList.xlsx" ' Change to your Excel file path
        strCFRTableName = "LinkedCFR" ' Name for your linked Access table
        strCFRRange = "A3:AZ" ' Adjust 'IV' to the last possible column containing data This links from A3 to the last used row in column IV
    
        DoCmd.TransferSpreadsheet _
            TransferType:=acLink, _
            SpreadsheetType:=acSpreadsheetTypeExcel12, _
            TableName:=strCFRTableName, _
            FileName:=strCFRFilePath, _
            HasFieldNames:=True, _
            Range:=strCFRRange
    End If
    
    'Link RCC Table if not already linked
    If DCount("*", "MSysObjects", "Name = 'LinkedRCC' And Type = 6") = 0 Then
        strRCCFilePath = "D:\Kevin Bolen\RCCList.xlsx" ' Change to your Excel file path
        strRCCTableName = "LinkedRCC" ' Name for your linked Access table
        strRCCRange = "A3:AZ" ' Adjust 'IV' to the last possible column containing data This links from A3 to the last used row in column IV


        DoCmd.TransferSpreadsheet _
            TransferType:=acLink, _
            SpreadsheetType:=acSpreadsheetTypeExcel12, _
            TableName:=strRCCTableName, _
            FileName:=strRCCFilePath, _
            HasFieldNames:=True, _
            Range:=strRCCRange
    End If


    'Link Work Spec Table if not already linked
    If DCount("*", "MSysObjects", "Name = 'LinkedWorkSpec' And Type = 6") = 0 Then
        strWSFilePath = "D:\Kevin Bolen\InProcessWSList.xlsx" ' Change to your Excel file path
        strWSTableName = "LinkedWorkSpec" ' Name for your linked Access table
        strWSRange = "A3:AZ" ' Adjust 'IV' to the last possible column containing data This links from A3 to the last used row in column IV


        DoCmd.TransferSpreadsheet _
            TransferType:=acLink, _
            SpreadsheetType:=acSpreadsheetTypeExcel12, _
            TableName:=strWSTableName, _
            FileName:=strWSFilePath, _
            HasFieldNames:=True, _
            Range:=strWSRange
    End If
    
    MsgBox "Excel file9S0 linked successfully!", vbInformation
    Exit Sub


ErrorHandler:
    MsgBox "Error linking Excel file: " & Err.Description, vbCritical


End Sub

[Soupy8728]

Did you comment out all your code after the on error statement?

I have now and IT WORKS PERFECTLY!!! Thanks!!