loop through all workbooks in a folder and import to access

[yjones]

Hello -

I am having a real tough time trying to figure out this code. I am trying to import a massive amount of excel workbooks in a file into an access database. I am able to figure out how to import one workbook into the database using the transferspreadsheet method, but I want to be able to use some loop code so that the vb module in access goes through many spreadsheets in a particular file. I tried putting the following code together, but it gives me a 'compiled error - user defined type not defined' error. I'm not very familiar with vb, so i was hoping someone knew what i am doing wrong or if this is totally wrong, help me with the proper coding. Thank you very much in advance for helping!

Sub allfolderfiles()
Dim wb As workbook
Dim TheFile As String
Dim MyPath As String
MyPath = "C:\Documents and Settings"
ChDir MyPath
TheFile = Dir("*.xls")
Do While TheFile <> ""
Set wb = Workbooks.Open(MyPath & "\" & TheFile)
DoCmd.TransferSpreadsheet acImport, 8, "newml", "C:\Documents and Settings\*.xls", True, "range"
wb.Close
TheFile = Dir
Loop
End Sub

 

[david.brent]

Hello there.
I am assuming a couple of things here.

That you have many work books and each 1 has only 1 worksheet and you are confident that only the right sort of spreadsheets are in the folder.

The first thing you need to do is figure out how many excel spreadsheets are in the folder. Then Import them. I'd do it somthing like this.

Sub Import_Workbooks()
Dim myFolder as String, fileLoop As Integer

myFolder="C:\Documents and Settings"

With Application.FileSearch
.LookIn = myFolder
.FileName = "*.xls"
.Execute
If .FoundFiles.Count > 0 Then
For fileLoop = 1 to .FoundFiles.Count
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "newml", .foundfiles(fileLoop)
Next fileloop
End If
End With
End Sub
This is from memory as the PC I'm using at the moment hasn't got MS Access on. Hope It helps.

 

[yjones]

thanks - don't know how many workbooks to import

Thanks for your help. However, I don't know how many workbooks i would need to import, there is a range from 7000 - 8000. What would I need to change in this code to make this work or could i still use the code you recommended? Thanks again!

 

[david.brent]

Hello again,
The code looks for all excel files in the chosen folder and it doesn't need to know how many excel files there are (.LookIn = myFolder
.FileName = "*.xls"). If you need to be selective eg after you have imported all of the existing spreadsheets you might want to bring new ones in say daily or weekly, you could put these in another folder and when they are imported, copy the Excel files into the master folder that holds all of the previous spreadsheets. Then if the database dies you could import everything in the master folder (this will include the newer spreadshets you have been copying in) and the table should be upto date. I would take regular backups of the databade too.

 

[yjones]

Thanks, it works!

Thanks David, its working well. You're a big help!

 

[WolfgangP]

Hi, Good work david.brent, I would like to know if you or anyone can give me code example/hints on how to import all the workbooks in an excel sheet.

 

[ghudson]

'Just change the text "TXT" parts to Excel "XLS" to meet your needs...

'Courtesy of Tim K.

'This sub will import all text files @ C:\Import TXT files\ and
'move them to the C:\Archived TXT Files\ folder. This example imports
'delimited text files with the import specification named TextImportSpecs
'and the imported files do not have field names.

Private Sub bImportFiles_Click()
On Error GoTo bImportFiles_Click_Err
    
    Dim objFS As Object, objFolder As Object
    Dim objFiles As Object, objF1 As Object
    Dim strFolderPath As String
    
    strFolderPath = "C:\Import TXT files\"
    Set objFS = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFS.GetFolder(strFolderPath)
    Set objFiles = objFolder.files
    
    For Each objF1 In objFiles
        If Right(objF1.Name, 3) = "txt" Then
            DoCmd.TransferText acImportDelim, "TextImportSpecs", "tblImportedFiles", strFolderPath & objF1.Name, False
            Name strFolderPath & objF1.Name As "C:\Archived TXT Files\" & objF1.Name 'Move the files to the archive folder
        End If
    Next
    
    Set objF1 = Nothing
    Set objFiles = Nothing
    Set objFolder = Nothing
    Set objFS = Nothing
    
bImportFiles_Click_Exit:
    Exit Sub
    
bImportFiles_Click_Err:
    MsgBox Err.Number & " " & Err.Description
    Resume bImportFiles_Click_Exit
    
End Sub