Importing multiple files into one access table

[cannunzi]

I'm trying to import multiple files in one access table all at once but i keep hitting an error stating incorrect file path. The code below works when i change the * to the exact file name but then it only imports the one file. I would like the code to import all files in the folder into the table. Any suggestions?

Sub FuelTaxImport()
 
DoCmd.TransferSpreadsheet acImport, , _
"FuelTaxReport", "C:\FuelTaxReports\*.xls", True, "FuelTaxReport!A1:M11"
 
MsgBox "Completed Importing"
 
End Sub
 

[Jim Doherty]

Hello,

I'm trying to import multiple files in one access table all at once but i keep hitting an error stating incorrect file path. The code below works when i change the * to the exact file name but then it only imports the one file. I would like the code to import all files in the folder into the table. Any suggestions?

Sub FuelTaxImport()

DoCmd.TransferSpreadsheet acImport, , _
"FuelTaxReport", "C:\FuelTaxReports\*.xls", True, "FuelTaxReport!A1:M11"

MsgBox "Completed Importing"

End Sub

Thank you!

Heres one way for you without using the TransferSpreadsheet method and that is to set a reference to the Microsoft Scripting runtime library (Theres nothing to stop you using transferspreadsheet in a loop I just fancied a change of method for once)

The following function accepts a folder path ie: "C:\myXLSFiles\" as a parameter passed to it. It then loops through the passed folder looking for XLS files once found it links them to the database as attached tables and opens each one as a recordset object, looping through each of the recordset fieldnames and building an INSERT SQL statement on the fly which it then executes during each loop appending records from the attached table into your FuelTaxReport table. (which incidentally I do not know your fieldnames for that so have opened a recordset from a table of the same name and retrieved the fieldnames by looping through its fieldnames as well)

Once records from each attached table is appended it removes the links to the tables so that they do not stay linked to your database (you can change this if you want by commenting out the relevant line immediately prior to the last END IF statement.

The assumptions in all of this is that all your spreadsheets are identical and are also consistent in their layout having the relevant field headers in row one of each spreadsheet which must be named as Sheet1 because this is the only spreadsheet it will work with using this procedure.

Regards

Jim :)

 
Function GetXLSFiles(FolderPath As String)
    On Error Resume Next
    'Ill leave you to your own error handling
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim strLnk As String
    Dim SQLText1 As String
    Dim fldText As String
    Dim SQLText3 As String
    Dim myins As String
    Dim fso As Object
    Dim XLSFiles, XLArray()
    Dim i, z
    Set dbs = CurrentDb()
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set XLSFiles = fso.GetFolder(FolderPath).Files
    ReDim XLArray(XLSFiles.Count - 1)
    SQLText1 = "INSERT INTO FuelTaxReport ("
    Set rst = dbs.OpenRecordset("SELECT * from FuelTaxReport WHERE false;")
    For z = 0 To rst.Fields.Count - 1
        fldText = fldText & rst.Fields(z).Name & ","
    Next z
    fldText = left(fldText, Len(fldText) - 1) & ") "
    rst.Close
    i = -1 
    For Each File In XLSFiles
        If right(File.Name, 4) = ".xls" Then
            i = i + 1
            XLArray(i) = left(File.Name, Len(File.Name) - 4)
            dbs.TableDefs.Delete XLArray(i)
            Set tdf = dbs.CreateTableDef(XLArray(i))
            strLnk = "Excel 8.0;HDR=YES;IMEX=2;DATABASE=" & FolderPath & File.Name & ";"
            tdf.Connect = strLnk
            tdf.SourceTableName = "Sheet1$"
            dbs.TableDefs.Append tdf
            Set rst = dbs.OpenRecordset("SELECT * from " & XLArray(i) & " WHERE false")
            For z = 0 To rst.Fields.Count - 1
                SQLText3 = SQLText3 & rst.Fields(z).Name & ","
            Next z
            SQLText3 = left(SQLText3, Len(SQLText3) - 1)
            rst.Close
            myins = SQLText1 & fldText & "SELECT " & SQLText3 & " FROM " & XLArray(i) & ";"
            Debug.Print myins
            DoCmd.RunSQL myins
            SQLText2 = ""
            SQLText3 = ""
        dbs.TableDefs.Delete XLArray(i)
        End If
    Next
    Application.RefreshDatabaseWindow
    MsgBox "Process Complete", vbInformation, "System Message"
    Set fso = Nothing
    Set rst = Nothing
    Set XLSFiles = Nothing
    Set tdf = Nothing
    strLnk = ""
    SQLText1 = ""
    fldText = ""
    SQLText3 = ""
    myins = ""
End Function
 

[cannunzi]

Heres one way for you without using the TransferSpreadsheet method and that is to set a reference to the Microsoft Scripting runtime library (Theres nothing to stop you using transferspreadsheet in a loop I just fancied a change of method for once)

The following function accepts a folder path ie: "C:\myXLSFiles\" as a parameter passed to it. It then loops through the passed folder looking for XLS files once found it links them to the database as attached tables and opens each one as a recordset object, looping through each of the recordset fieldnames and building an INSERT SQL statement on the fly which it then executes during each loop appending records from the attached table into your FuelTaxReport table. (which incidentally I do not know your fieldnames for that so have opened a recordset from a table of the same name and retrieved the fieldnames by looping through its fieldnames as well)

Once records from each attached table is appended it removes the links to the tables so that they do not stay linked to your database (you can change this if you want by commenting out the relevant line immediately prior to the last END IF statement.

The assumptions in all of this is that all your spreadsheets are identical and are also consistent in their layout having the relevant field headers in row one of each spreadsheet which must be named as Sheet1 because this is the only spreadsheet it will work with using this procedure.

Regards

Jim :)

 
Function GetXLSFiles(FolderPath As String)
    On Error Resume Next
    'Ill leave you to your own error handling
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim tdf As DAO.TableDef
    Dim strLnk As String
    Dim SQLText1 As String
    Dim fldText As String
    Dim SQLText3 As String
    Dim myins As String
    Dim fso As Object
    Dim XLSFiles, XLArray()
    Dim i, z
    Set dbs = CurrentDb()
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set XLSFiles = fso.GetFolder(FolderPath).Files
    ReDim XLArray(XLSFiles.Count - 1)
    SQLText1 = "INSERT INTO FuelTaxReport ("
    Set rst = dbs.OpenRecordset("SELECT * from FuelTaxReport WHERE false;")
    For z = 0 To rst.Fields.Count - 1
        fldText = fldText & rst.Fields(z).Name & ","
    Next z
    fldText = left(fldText, Len(fldText) - 1) & ") "
    rst.Close
    i = -1 
    For Each File In XLSFiles
        If right(File.Name, 4) = ".xls" Then
            i = i + 1
            XLArray(i) = left(File.Name, Len(File.Name) - 4)
            dbs.TableDefs.Delete XLArray(i)
            Set tdf = dbs.CreateTableDef(XLArray(i))
            strLnk = "Excel 8.0;HDR=YES;IMEX=2;DATABASE=" & FolderPath & File.Name & ";"
            tdf.Connect = strLnk
            tdf.SourceTableName = "Sheet1$"
            dbs.TableDefs.Append tdf
            Set rst = dbs.OpenRecordset("SELECT * from " & XLArray(i) & " WHERE false")
            For z = 0 To rst.Fields.Count - 1
                SQLText3 = SQLText3 & rst.Fields(z).Name & ","
            Next z
            SQLText3 = left(SQLText3, Len(SQLText3) - 1)
            rst.Close
            myins = SQLText1 & fldText & "SELECT " & SQLText3 & " FROM " & XLArray(i) & ";"
            Debug.Print myins
            DoCmd.RunSQL myins
            SQLText2 = ""
            SQLText3 = ""
        dbs.TableDefs.Delete XLArray(i)
        End If
    Next
    Application.RefreshDatabaseWindow
    MsgBox "Process Complete", vbInformation, "System Message"
    Set fso = Nothing
    Set rst = Nothing
    Set XLSFiles = Nothing
    Set tdf = Nothing
    strLnk = ""
    SQLText1 = ""
    fldText = ""
    SQLText3 = ""
    myins = ""
End Function
 

Jim,

I greatly appreciate your feedback on my request but I’m a rookie programmer. Can you suggest the loop method which is more familiar to me then the complex code provided? All my files have the exact column headers but are on a sheet called FuelTaxReport which is not the first sheet.

Thank you!

[Jim Doherty]

Jim,

I greatly appreciate your feedback on my request but I’m a rookie programmer. Can you suggest the loop method which is more familiar to me then the complex code provided? All my files have the exact column headers but are on a sheet called FuelTaxReport which is not the first sheet.

Thank you!

I understand I apologise for introducing something you didn't understand a bad communicator is no communicator at all…. well first of all lets have a look at what your original proposal was for importing your spreadsheet and we will go with that

 
 
 DoCmd.TransferSpreadsheet acImport, , _
 "FuelTaxReport", "C:\FuelTaxReports\*.xls", True, "FuelTaxReport!A1:M11"
 
 

Now what this is going to want to do is a ‘single’ import of a file called …wait for it…….asterisk.xls….which of course does not exist. I understand your logic in doing that but unfortunately it doesn’t work like that. You have to define an absolute path to a filename in the file portion of the Transferspreadsheet method

From what you are saying each and every spreadsheet is identical in layout and the area of the spreadsheet you wish to import comes from the range defined as A1:M11 on the worksheet called FuelsTaxReport

So…. if we wished to use that transferspreadsheet command ‘as is’ you would have to pass to it the names of each of your workbook files and the name of the spreadsheet within the workbook and change specific sections of it to reference each file contained in a folder in which those spreadsheets are kept. In other words the command would have to mirror the current file being looked at in any loop of a folder in which we were wishing to retrieve a bunch of XLS workbook files

So we have to examine a folder…how are we going to do that? Well… there are various methods and the example I did earlier merely calls upon the windows scripting runtime library to provide that functionality. You don’t have to do it that way of course

We can trim all of this down for you to a more understandable routine but in so doing I am going to ask you to firstly create a table called tblFuelTaxReports with suitable Fieldnames and datatypes that ‘mirrors’ and provides for a successful importation of the values of any data you have in columns in each of those spreadsheet columns A1 to M11. In short you have to make sure you determine whether you want Text datatype or whether the field values are numeric or datetime and so on. We are going to use this table to import all of the values from each spreadsheet directly into it.

Paste the following code into a new module after the Option Compare Database line then save the module

(The functional syntax is actually very short but contains a fair amount of commenting to enable you to follow it)

 
Function MyXLSFiles(FolderPath As String)
'Returns xls files in the folder path passed
' calling convention is this
'firstly if any error is encountered disregard it and move to the next line
    On Error Resume Next
    Dim MyDir As String, RetVal As String, i As Long
    'return to that variable the DIR function call for files of XLS extension
    'in the given folderpath
    MyDir = Dir$(FolderPath & "*.xls", vbNormal)
 
    'initialise 'i' variable for use in the loop to display in status bar
    i = 0
 
    'Now 'do' something until the number of bytes used to represent the MyDir string
    'returns a zero value
    Do Until LenB(MyDir) = 0
 
        'lets print to the immediate window the value of any filename examined in the loop
        Debug.Print MyDir
 
        'show some progress using the status bar
        RetVal = SysCmd(acSysCmdInitMeter, "Reading file..." & MyDir, i)
 
        'This is the main workhorse bit ...
        'notice how passed to it is the folderpath parameter portion
        'and concatenated to that is the ever changing filename grabbed
        'whilst in the loop. The transferspreadsheet command expects to retrieve
        'consistent values having field headers and located at the range A1:M11
        'each time in the loop. If it doesnt your routine fails!!
        DoCmd.TransferSpreadsheet acImport, 8, "FuelTaxReport", _
                                 FolderPath & MyDir, True, "FuelTaxReport!A1:M11"
        MyDir = Dir$    ' Get the next entry
        'update status bar and then return to loop
        RetVal = SysCmd(acSysCmdUpdateMeter, i)
        i = i + 1
    Loop
 
    'reset to status bar to its default
    RetVal = SysCmd(acSysCmdRemoveMeter)
 
    'and display a quick message to say the process is complete
    MsgBox "Process Complete", vbInformation, "System Message"
End Function
 

Now what does this routine do? Well firstly it expects a filepath to be passed to it that must contain the trailing backslash,. (I could code for this and test that it is actually passed but I am not going to ‘purposefully’ in order to reduce the code lines you actually want to read. You could also be clever and introduce a capability for the user to select the folder using the windows folder dialog picker but again I am not going to that for you in favour of you reading and understanding that which you see thus far. (You can always add that later)

So how do you get this thing working?? well create a form and mount on it a button and in its 'on click' event procedure you can either type this directly into the properties section

=MyXLSFiles("C:\FuelTaxReports\")

OR click on the code elipsis button go into the VBA code window and between the lines for the command buttons on click sub procedure and end sub lines..type this

MyXLSFiles("C:\FuelTaxReports\")


Hope this revision clears things for you

Regards

Jim :)

[cannunzi]

I understand I apologise for introducing something you didn't understand a bad communicator is no communicator at all…. well first of all lets have a look at what your original proposal was for importing your spreadsheet and we will go with that

 
 
 DoCmd.TransferSpreadsheet acImport, , _
 "FuelTaxReport", "C:\FuelTaxReports\*.xls", True, "FuelTaxReport!A1:M11"
 
 

Now what this is going to want to do is a ‘single’ import of a file called …wait for it…….asterisk.xls….which of course does not exist. I understand your logic in doing that but unfortunately it doesn’t work like that. You have to define an absolute path to a filename in the file portion of the Transferspreadsheet method

From what you are saying each and every spreadsheet is identical in layout and the area of the spreadsheet you wish to import comes from the range defined as A1:M11 on the worksheet called FuelsTaxReport

So…. if we wished to use that transferspreadsheet command ‘as is’ you would have to pass to it the names of each of your workbook files and the name of the spreadsheet within the workbook and change specific sections of it to reference each file contained in a folder in which those spreadsheets are kept. In other words the command would have to mirror the current file being looked at in any loop of a folder in which we were wishing to retrieve a bunch of XLS workbook files

So we have to examine a folder…how are we going to do that? Well… there are various methods and the example I did earlier merely calls upon the windows scripting runtime library to provide that functionality. You don’t have to do it that way of course

We can trim all of this down for you to a more understandable routine but in so doing I am going to ask you to firstly create a table called tblFuelTaxReports with suitable Fieldnames and datatypes that ‘mirrors’ and provides for a successful importation of the values of any data you have in columns in each of those spreadsheet columns A1 to M11. In short you have to make sure you determine whether you want Text datatype or whether the field values are numeric or datetime and so on. We are going to use this table to import all of the values from each spreadsheet directly into it.

Paste the following code into a new module after the Option Compare Database line then save the module

(The functional syntax is actually very short but contains a fair amount of commenting to enable you to follow it)

 
Function MyXLSFiles(FolderPath As String)
'Returns xls files in the folder path passed
' calling convention is this
'firstly if any error is encountered disregard it and move to the next line
    On Error Resume Next
    Dim MyDir As String, RetVal As String, i As Long
    'return to that variable the DIR function call for files of XLS extension
    'in the given folderpath
    MyDir = Dir$(FolderPath & "*.xls", vbNormal)
 
    'initialise 'i' variable for use in the loop to display in status bar
    i = 0
 
    'Now 'do' something until the number of bytes used to represent the MyDir string
    'returns a zero value
    Do Until LenB(MyDir) = 0
 
        'lets print to the immediate window the value of any filename examined in the loop
        Debug.Print MyDir
 
        'show some progress using the status bar
        RetVal = SysCmd(acSysCmdInitMeter, "Reading file..." & MyDir, i)
 
        'This is the main workhorse bit ...
        'notice how passed to it is the folderpath parameter portion
        'and concatenated to that is the ever changing filename grabbed
        'whilst in the loop. The transferspreadsheet command expects to retrieve
        'consistent values having field headers and located at the range A1:M11
        'each time in the loop. If it doesnt your routine fails!!
        DoCmd.TransferSpreadsheet acImport, 8, "FuelTaxReport", _
                                 FolderPath & MyDir, True, "FuelTaxReport!A1:M11"
        MyDir = Dir$    ' Get the next entry
        'update status bar and then return to loop
        RetVal = SysCmd(acSysCmdUpdateMeter, i)
        i = i + 1
    Loop
 
    'reset to status bar to its default
    RetVal = SysCmd(acSysCmdRemoveMeter)
 
    'and display a quick message to say the process is complete
    MsgBox "Process Complete", vbInformation, "System Message"
End Function
 

Now what does this routine do? Well firstly it expects a filepath to be passed to it that must contain the trailing backslash,. (I could code for this and test that it is actually passed but I am not going to ‘purposefully’ in order to reduce the code lines you actually want to read. You could also be clever and introduce a capability for the user to select the folder using the windows folder dialog picker but again I am not going to that for you in favour of you reading and understanding that which you see thus far. (You can always add that later)

So how do you get this thing working?? well create a form and mount on it a button and in its 'on click' event procedure you can either type this directly into the properties section

=MyXLSFiles("C:\FuelTaxReports\")

OR click on the code elipsis button go into the VBA code window and between the lines for the command buttons on click sub procedure and end sub lines..type this

MyXLSFiles("C:\FuelTaxReports\")


Hope this revision clears things for you

Regards

Jim :)

Jim,

I greatly appreciate your time on helping me with the import code. I created the button & set all criteria for field settings & got it to work.

Thanks a million.

cannunzi

cannunzi

[Jim Doherty]

Jim,

I greatly appreciate your time on helping me with the import code. I created the button & set all criteria for field settings & got it to work.

Thanks a million.

cannunzi

cannunzi

Well done I am pleased you were successful you are welcome

Regards

Jim :)

[gatway2k]

I've used this code successfully as well, except I have one file in my dataset that is 60,000 records. The import appears to continue beyond the last record... I cancel the code and when I attempted to delete the data in the table, the query showed 150,000+ records (80,000+ on my subsequent attempts)... my range has been just the sheet name, but I am able to import the problem file with the "!A1:M60000"... just curious why it's not recognizing the actual last record... opening the file, excel recognizes the last record... I even tried saving with a1 as the active cell and adjusting the xls version... any advice?

[Jim Doherty]

The last argument of the transferspreadsheet action asks for the range argument. If you leave this out it will import the entire spreadsheet.

Direct lift from Microsoft help if you read it referencing the TransferSpreadsheet action:-

A string expression that's a valid range of cells or the name of a range in the spreadsheet. This argument applies only to importing. Leave this argument blank to import the entire spreadsheet.

Chances are particularly if looping and loading many xls files in your folder it might have picked up one at least one of them that was non standard to your import expectation and had something in it to cause it to keep loading. Other than that I have no idea I am afraid, given I do not see your environment.