Importing a folders worth of excel work books into Acess

[chrisbrocco]

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

 

[Norie]

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.

 

[chrisbrocco]

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

 

[SydneyGeek]

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

 

[chrisbrocco]

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

 

[chrisbrocco]

Also is it possible to when adding each file that the file name is attached to each record

 

[SydneyGeek]

Here's some sample 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

 

[chrisbrocco]

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

 

[SydneyGeek]

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 --

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 --

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

 

[Vexorg]

Hi i need help filling out the macro below:

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?

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