asked on

Dynamically linking Excel worksheets to an Access Database

As you can see from my screen shot, I’m using the following sub routine to link various worksheets from ExcelFile.xlsx into my database. As shown below, I’ve linked only four worksheets. However, my actually worksheet has many more tabs that I need to link. Also, the tab names are not constant. In other words, I could have three worksheets named like: 1111, 2222, 3333. Then at a later time for the exact same file, I could have four worksheets with multiple other names like: AAAA, BBBB, CCCC, DDDD.

Right now, it’s a manual process for me to update this code each time a sheet name changes or is removed. I’d like to modify this code to be more dynamic by accomplishing the following:

1. First delete all database table objects that have a string of 4 characters in their name (e.g. 1111, 2233, AABC)
2. Link all worksheet tabs that have a string of 4 characters in their name from ExelFile.xlsx

I'm using MS office 2016. Any Expert suggestion on this is greatly appreciated! =)

Private Sub LinkSpreadSheets()

Dim Fpath As String, _
  XLname1 As String, _
  tb1 As String, _
  tb2 As String, _
  tb3 As String, _
  tb4 As String

Fpath = Environ("USERPROFILE") & "\Documents\databases"

XLname1 = "\ExcelFile.xlsx"
                   
tb1 = "1001"
tb2 = "2001"
tb3 = "3001"
tb4 = "F008"

With DoCmd

    .DeleteObject acTable, "1001"
    .DeleteObject acTable, "2001"
    .DeleteObject acTable, "3001"
    .DeleteObject acTable, "F008"

    .TransferSpreadsheet acLink, , tb1, Fpath & XLname1, True, "1001$"
    .TransferSpreadsheet acLink, , tb2, Fpath & XLname1, True, "2001$"
    .TransferSpreadsheet acLink, , tb2, Fpath & XLname1, True, "3001$"
    .TransferSpreadsheet acLink, , tb2, Fpath & XLname1, True, "F008$"
               
End With
 
End Sub

Open in new window

Joshua Kinsel

Public Sub List_worksheets(ByVal pWorkBook As String)
'Dim objExc As Excel.Application ' early
'Dim objWbk As Excel.Workbook ' early
'Dim objWsh As Excel.Worksheet ' early
Dim objExc As Object ' late
Dim objWbk As Object ' late
Dim objWsh As Object ' late

'Set objExc = New Excel.Application ' early
Set objExc = CreateObject("Excel.Application") ' late
Set objWbk = objExc.Workbooks.Open(pWorkBook)
For Each objWsh In objWbk.Worksheets
Debug.Print objWsh.Name
Next
Set objWsh = Nothing
objWbk.Close
Set objWbk = Nothing
objExc.Quit
Set objExc = Nothing
End Sub

Joshua Kinsel

Use this to get names of sheets. Then use if statements to modify your code and assign the tb1 through tb4 strings.
If objWsh.Name = "1001" then
Set your strings to this
Else
Set strings to other format

End if

ASKER CERTIFIED SOLUTION

ste5an

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

KP_SoCal

ASKER

Joshua and Ste5an...thanks for the invaluable feedback!

ste5an--ingenius! Thank you!!!

KP_SoCal

ASKER

Also, as a post script to this solution, I had some issues with the following block of code:

Public Sub RemoveLinkedTables()

  Dim Database As DAO.Database
  Dim TableDef As DAO.TableDef

  Set Database = CurrentDb
  For Each TableDef In Database.TableDefs
    If Len(TableDef.Name) = 4 And TableDef.Attributes And dbAttachedODBC = dbAttachedODBC Then
      Database.TableDefs.Delete TableDef.Name
    End If
  Next TableDef

  Set TableDef = Nothing
  Set Database = Nothing

End Sub

Open in new window

To reserve, I used this in its place.

   Dim db As DAO.Database
   Dim tdf As DAO.TableDef
   Set db = CurrentDb

   For Each tdf In db.TableDefs
       If Len(tdf.Name) = 4 Then
           DoCmd.DeleteObject acTable, tdf.Name
       End If
   Next

Open in new window

Have a terrific weekend!

ste5an

What kind of problem?

My code only removes linked tables, whereas yours will delete every table having a name of length 4.