Importing a folders worth of excel work books into Acess

chrisbrocco

Board Regular
Joined
Mar 31, 2005
Messages
82
Is there a way (using VBA) to point to a folder and make access import all the files (which will be excel files) into a access a table.

Prefrably beable to say which colums it imports
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Chris

This is perfectly possible.:)

To do the actual import you could use DoCmd.TransferSpreadsheet.

And there are various ways to loop through files in a folder. eg Application.FileSearch.

We'd need more details to be more specific.
 
Upvote 0
Hi thanks for replying.

I would like to import from a single folder.

there would be multiple excel files - each with 3 tabs in

The file names of the excel files would be different

I would like to specifie which colums to import

and would import all the information in a single table

hope this can help

many thanks

again
 
Upvote 0
Chris, some clarification.

1. Multiple files in one folder. Will the folder change, or is this a one-off?
2. Each workbook has 3 tabs; does each sheet need to be imported, and are they all the same layout?
3. You only want to import certain columns. There are a couple of ways to do this. One is to import everything into a dummy table, then use an Append query to push the selected fields into the final table. This has the advantage that the import code is much simpler, and also that you don't have to exactly match the names of the Excel columns with the Access fields.

Is this on the right track?

Denis
 
Upvote 0
The folder will remain the same - I will update the folder with the new files

Each sheet does need to be imported and will be in the same format

Importing everything would be ok and then amend it in Access
 
Upvote 0
Here's some sample code:
Code:
'Import from multiple sheets in multiple files, in a set folder.
'Note: This borrows heavily from code provided by andrew93.
'You will need to set a reference to the 'Microsoft Office x.0 Object Library'
'where x is your version number.
'This can be found under Tools > References in the VBA editor screen.
'You may also need to set a reference to Microsoft Scripting Runtime.

Function ImportExcelFiles()
Dim Counter As Integer

With Application.FileSearch
    .NewSearch
    .LookIn = "C:\ImportDir" 'change this to your actual directory
    .SearchSubFolders = False 'set to True if you want to search subfolders too
    .FileType = msoFileTypeAllFiles 'get all files in the directory -- ensure only Excel files are in this folder

    If .Execute() > 0 Then 'files found
        For Counter = 1 To .FoundFiles.Count 'loop through files
            .FileName = .FoundFiles(Counter) 'set / get the file name
            'Change the "ImportFile" part in the line below if you are using a different table name
            'Note: 1 command for each worksheet. I have assumed they are Sheet1 etc.
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "ImportFile", .FileName, False, [Sheet1$]
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "ImportFile", .FileName, False, [Sheet2$]
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "ImportFile", .FileName, False, [Sheet3$]
            DoEvents 'don't take over all of the PC resources
        Next Counter
        MsgBox "Import complete.", vbInformation, "Done"
    Else 'files not found
        MsgBox "There were no files found.", vbCritical, "Error"
    End If
End With
End Function
Note: The False parameter in the TransferSpreadsheet commands indicates that columns don't have headers. If they do, change this to True

The best way to create the dummy table is to directly import one of the Excel files into Access, then delete the data and any "spare" fields from the table once it is in Access. The "spares" will have the descriptive names F1, F2, etc, and will follow the real field names.

Hope this helps
Denis
 
Upvote 0
Function ImportExcelFiles()
Dim Counter As Integer

With Application.FileSearch
.NewSearch
.LookIn = "\C:\ImportDir" 'change this to your actual directory
.SearchSubFolders = False 'set to True if you want to search subfolders too
FileName = "*.xls" 'changed HERE

If .Execute() > 0 Then 'files found
For Counter = 1 To .FoundFiles.Count 'loop through files
.FileName = .FoundFiles(Counter) 'set / get the file name
'Change the "ImportFile" part in the line below if you are using a different table name
'Note: 1 command for each worksheet. I have assumed they are Sheet1 etc.
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, False, "Sheet1!"'Changed HERE
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, False, "Sheet1!"'Changed HERE
'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, True, "Sheet1!"'Changed HERE

DoEvents 'don't take over all of the PC resources
Next Counter
MsgBox "Import complete.", vbInformation, "Done"
Else 'files not found
MsgBox "There were no files found.", vbCritical, "Error"
End If
End With
End Function


just changed the $ to !

and .FileType = msoFileTypeAllFiles to FileName = "*.xls"

Works perfectly many thanks.

One addtional piece of help would be great. How could I tag the name of the workbook and/or sheet name to each record I import
 
Upvote 0
Hi Chris,

A couple of changes: I'll insert the comments for you. Assuming that you have a field in Table1 called xlFile (Text, 255 chars) you could create an update query like this --

Code:
Dim sSQL As String

sSQL = "UPDATE Table1 SET Table1.xlFile = "" & .Filename & "" " _
   & "WHERE Table1.xlFile Is Null;"

You can then run it once you have imported the sheets from a workbook --

Code:
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, False, "Sheet1!"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, False, "Sheet2!"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, False, "Sheet3!"
DoCmd.SetWarnings False
DoCmd.RunSQL sSQL
DoCmd.SetWarnings True

Denis
 
Upvote 0
Hi i need help filling out the macro below:

Code:
Function ImportExcelFiles()
Dim Counter As Integer

With Application.FileSearch
.NewSearch
.LookIn = "\C:\ImportDir" 'change this to your actual [B][COLOR=#ff0000]directory
[/COLOR][/B].SearchSubFolders = False 'set to True if you want to search subfolders too
FileName = "*.xls" 'changed HERE

If .Execute() > 0 Then '[B][COLOR=#ff0000]files[/COLOR][/B] found
For Counter = 1 To .FoundFiles.Count 'loop through [B][COLOR=#ff0000]files
[/COLOR][/B].FileName = .FoundFiles(Counter) 'set / get the file name
'Change the "ImportFile" part in the line below if you are using a different table name
'Note: 1 command for each worksheet. I have assumed they are Sheet1 etc.
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, False, "Sheet1!"'Changed HERE
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, False, "Sheet1!"'Changed HERE
'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, True, "Sheet1!"'Changed HERE

DoEvents 'don't take over all of the PC resources
Next Counter
MsgBox "[B][COLOR=#ff0000]Import[/COLOR][/B] complete.", vbInformation, "Done"
Else '[B][COLOR=#ff0000]files[/COLOR][/B] not found
MsgBox "There were no [B][COLOR=#ff0000]files[/COLOR][/B] found.", vbCritical, "Error"
End If
End With
End Function

Heres my info:
The directory is C:\Documents and Settings\abc\Desktop\ClearExtracts
File name: core
Worksheets(15): They are named Result 1, Result 2, Result 3, ..., Result 15
I want all the worksheets to be added to a access table called "core"

I dont think im doing this correctly becasue i get an error when it runs should i be putting the file name somewhere else aslo?

Code:
Function ImportExcelFiles()
Dim Counter As Integer

With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\abc\Desktop\ClearExtracts" 'change this to your actual [B][COLOR=#ff0000]directory
[/COLOR][/B].SearchSubFolders = False 'set to True if you want to search subfolders too
FileName = "core.xls" 'changed HERE

If .Execute() > 0 Then '[B][COLOR=#ff0000]files[/COLOR][/B] found
For Counter = 1 To .FoundFiles.Count 'loop through [B][COLOR=#ff0000]files
[/COLOR][/B].FileName = .FoundFiles(Counter) 'set / get the file name
'Change the "ImportFile" part in the line below if you are using a different table name
'Note: 1 command for each worksheet. I have assumed they are Sheet1 etc.
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, False, "Result 1!"'Changed HERE
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, False, "Result 2!"'Changed HERE
'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Table1", .FileName, True, "Result 3!"'Changed HERE

DoEvents 'don't take over all of the PC resources
Next Counter
MsgBox "[B][COLOR=#ff0000]Import[/COLOR][/B] complete.", vbInformation, "Done"
Else '[B][COLOR=#ff0000]files[/COLOR][/B] not found
MsgBox "There were no [B][COLOR=#ff0000]files[/COLOR][/B] found.", vbCritical, "Error"
End If
End With
End Function
 
Upvote 0

Forum statistics

Threads
1,224,584
Messages
6,179,693
Members
452,938
Latest member
babeneker

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top