Dynamically linking Excel worksheets to an Access Database

KP_SoCal
KP_SoCal used Ask the Experts™
on
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


Screenshot
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Joshua KinselComputer Programmer

Commented:
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 KinselComputer Programmer

Commented:
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
Senior Developer
Commented:
It depends where you run the code, in Access:

Option Compare Database
Option Explicit

Public Sub Test()

  RemoveLinkedTables
  LinkTables "C:\Temp\Book1.xlsx"

End Sub

Public Sub LinkTables(ByVal CExcelFileName As String)

  Dim SheetName As Variant

  For Each SheetName In SheetNames(CExcelFileName)
    Debug.Print "Linking " & SheetName & "."
    DoCmd.TransferSpreadsheet acLink, , SanitzeSheetName(SheetName), CExcelFileName, True, SheetName
  Next SheetName

End Sub

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

Public Function SheetNames(ByVal CExcelFileName As String) As VBA.Collection

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

  Set SheetNames = New VBA.Collection
  Set Database = DBEngine.OpenDatabase(CExcelFileName, True, False, "Excel 12.0")
  For Each TableDef In Database.TableDefs
    If Len(TableDef.Name) >= 4 Then
      If Len(SanitzeSheetName(TableDef.Name)) = 4 Then
        SheetNames.Add TableDef.Name
      End If
    End If
  Next TableDef

  Set TableDef = Nothing
  Database.Close
  Set Database = Nothing

End Function

Public Function SanitzeSheetName(ByVal CSheetName As String) As String
' Not complete, just for getting names for the current problem.

  Dim Result As String

  Result = CSheetName
  If Len(Result) > 3 Then
    If Right(Result, 1) = "$" Then
      Result = Mid(Result, 1, Len(Result) - 1)
    End If

    If Left(Result, 1) = "'" And Right(Result, 2) = "$'" Then
      Result = Mid(Result, 2, Len(Result) - 3)
    End If

    Result = Replace(Result, "''", "'")
  End If

  SanitzeSheetName = Result

End Function

Open in new window

It requires of course proper error handling.
Exploring SQL Server 2016: Fundamentals

Learn the fundamentals of Microsoft SQL Server, a relational database management system that stores and retrieves data when requested by other software applications.

Author

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

ste5an--ingenius! Thank you!!!

Author

Commented:
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!
ste5anSenior Developer

Commented:
What kind of problem?

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

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial