How to process ALL the Excel files from 1 folder using Access VBA code?

I am developing an Access application using Access 2003 and an MDB type file.

In the code section that follows, I have a routine that executes when the user clicks on an Import command button.

This routine imports 1 Excel file (containing 4 worksheets), whose name is populated in a text box named txtFileNm.Value and processes the Excel file's records.

The user needs to process over 20 Excel files. So currently, using this routine, the user selects an Excel file and then clicks on the Import command button. Then the user selects another Excel file and clicks the Import command button once again. This process is repeated multiple times until all Excel files have been imported and processed.

Can you think of a rewrite of this routine so that ALL Excel files in a chosen folder are processed at 1 time after clicking on the Import command button ?
Private Sub cmdImport_Click()
On Error Resume Next
Dim dt As Date
Dim rst As ADODB.Recordset
Dim con As ADODB.Connection
Dim ssql As String
Dim ssql1 As String
Set con = CurrentProject.Connection
Set rst = New ADODB.Recordset
Dim tbl As TableDef
Dim db As Database
Set db = CurrentDb()

If txtFileNm.Value = Null Or IsNull(txtFileNm.Value) Or txtFileNm.Value = "" Or txtFileNm.Value = "No file was selected" Then
    MsgBox ("You must select a file first")
    Exit Sub
Else
    filenm = txtFileNm.Value
End If

'export 4 sheets
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Bank Credits (A)", filenm, False, "Bank Credits (A)!A:N"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Bank Debits (B)", filenm, False, "Bank Debits (B)!A:N"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Book Debits (C)", filenm, False, "Book Debits (C)!A:N"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Book Credits (D)", filenm, False, "Book Credits (D)!A:N"

Dim bankNum As String
ssql = "select f1, f2 from [Bank Credits (A)] where left(f1,3)='BRS'"
rst.Open ssql, con, 2, 2
bankNum = Trim(rst("f2"))
rst.Close

ssql = "insert into tblOpenItemsHistory select * from tblOpenItems where bank='" & bankNum & "'"
rst.Open ssql, con, 2, 2

ssql = "delete * from tblOpenItems where bank='" & bankNum & "'"
rst.Open ssql, con, 2, 2

ssql = "insert into tblOpenItems (bank, office, checknum,refno, [trans date], type,[process date], agedays, t, description, amount, manual,rptid, [report name], footnote,responsibility) "
ssql1 = " SELECT '" & bankNum & "',f7,f8,f10, cdate(f2),f4,cdate(f1), GetNumberOfWorkDays(f1, now()), f3,f5,f9, 'I',( select rptid from tblbanks where [bank code]='" & bankNum & "'),( select [report name] from tblbanks where [bank code]='" & bankNum & "'), f11,f14 FROM [Bank Credits (A)]   WHERE (IsNumeric([f9])<>False) AND (F1 Is Not Null);"
rst.Open ssql & ssql1, con, 2, 2
'for B
ssql = "insert into tblOpenItems (bank, office, checknum,refno, [trans date], type,[process date], agedays, t, description, amount, manual, rptid,  [report name], footnote,responsibility) "
ssql1 = " SELECT '" & bankNum & "',f7,f8,f10, cdate(f2),f4,cdate(f1), GetNumberOfWorkDays(f1, now()), f3,f5,f9, 'I',( select rptid from tblbanks where [bank code]='" & bankNum & "'), ( select [report name] from tblbanks where [bank code]='" & bankNum & "'), f11,f14  FROM [Bank Debits (B)]  where (IsNumeric([f9])<>False) AND (F1 Is Not Null);"
rst.Open ssql & ssql1, con, 2, 2
'for C
ssql = "insert into tblOpenItems (bank, office, checknum,refno, [trans date], type,[process date], agedays, t, description, amount, manual, rptid,  [report name], footnote,responsibility) "
ssql1 = " SELECT '" & bankNum & "',f7,f8,f10, cdate(f2),f4,cdate(f1), GetNumberOfWorkDays(f1, now()), f3,f5,f9, 'I',( select rptid from tblbanks where [bank code]='" & bankNum & "'), ( select [report name] from tblbanks where [bank code]='" & bankNum & "'), f11,f14  FROM [Book Debits (C)]  where (IsNumeric([f9])<>False) AND (F1 Is Not Null);"
rst.Open ssql & ssql1, con, 2, 2
'for D
ssql = "insert into tblOpenItems (bank, office, checknum,refno, [trans date], type,[process date], agedays, t, description, amount, manual, rptid,  [report name], footnote,responsibility) "
ssql1 = " SELECT '" & bankNum & "',f7,f8,f10, cdate(f2),f4,cdate(f1), GetNumberOfWorkDays(f1, now()), f3,f5,f9, 'I',( select rptid from tblbanks where [bank code]='" & bankNum & "'), ( select [report name] from tblbanks where [bank code]='" & bankNum & "'), f11,f14 FROM [Book Credits (D)]  where (IsNumeric([f9])<>False) AND (F1 Is Not Null);"
rst.Open ssql & ssql1, con, 2, 2

DoCmd.RunMacro "mcrReports.CreateAged"

Set rst = Nothing

MsgBox ("File has been transfered successfully!")
txtFileNm.Value = ""

End Sub

Open in new window

zimmer9Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Rey Obrero (Capricorn1)Commented:

try this , you have to supply the folder path
On Error Resume Next
Dim dt As Date
Dim rst As ADODB.Recordset
Dim con As ADODB.Connection
Dim ssql As String
Dim ssql1 As String

dim xlFile as string, xlPath as string,filenm

Set con = CurrentProject.Connection
Set rst = New ADODB.Recordset
Dim tbl As TableDef
Dim db As Database
Set db = CurrentDb()

xlpath="c:\folderName\"

xlfile=dir(xlPath & "*.xls")

while xlFile <> ""
	filenm=xlpath & xlFile

'export 4 sheets
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Bank Credits (A)", filenm, False, "Bank Credits (A)!A:N"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Bank Debits (B)", filenm, False, "Bank Debits (B)!A:N"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Book Debits (C)", filenm, False, "Book Debits (C)!A:N"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Book Credits (D)", filenm, False, "Book Credits (D)!A:N"


    xlFile=dir

wend

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.