VBAmazing
VBAmazing

Reputation: 52

Real-Time Database Updating

I have ~300 Identical Excel Spreadsheets (.xlsx) that all have ten different cells I would like to project to an Access database. Some are single cells, a few ranges-- all of them are named in each individual workbook. The database should hold all values from the same worksheet on the same line, and all numbers should update in real time.

My goal is to use access to keep a running record on the contents of these cells. I have attempted to link the workbooks to the Master Access database using: External Data->Import and Link->Excel->Link to the data source by creating a linked table-> and here I would select one of the named ranges and click 'Finish', but I can only do this once per spreadsheet. This makes repeating this process for all spreadsheets unfeasible.

Is there a way to use Access VBA to create a linked Excel Table for each Workbook in the folder?

I am sort of teaching myself Access, and am still relatively new at it so any insight will help.

Cheers.

Upvotes: 0

Views: 97

Answers (1)

Erik A
Erik A

Reputation: 32682

Luckily, I had just that lying around somewhere. This links all excel files in the same folder as the database.

Note that this just uses the file name as the tablename, and links everything using default settings. Change the DoCmd.TransferSpreadsheet line to customize it. Originally I have this linked to a form so I can choose what to import, and how it is handled.

Public Sub ImportExcel()
    Dim objFSO As Object 'FileSystemObject
    Dim databasefolderlocation As String
    Dim objFolder As Object 'Folder
    Dim objFile As Variant
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    databasefolderlocation = Application.CurrentProject.Path 'This sets the folder, you can change it for another folder
    Set objFolder = objFSO.GetFolder(databasefolderlocation)
    For Each objFile In objFolder.Files
        If objFile.Name Like "*.xls" Or objFile.Name Like "*.xlsx" Then
            DoCmd.TransferSpreadsheet acLink, , objFile.Name, objFile.Path
        End If
    Next objFile
End Sub

Upvotes: 2

Related Questions