• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 637
  • Last Modified:

Loop through folders and subfolders when importing into table instead of a single folder

access 2010 vba
excel 2010 vba

reference question:
http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_27857915.html

The following routines works great when examining a single folder:

What I need:
I need the routines to loop through all the workbooks and worksheets in each sub folder also:






Sub importexcel2()
Dim xlObj As Object, Sheet As Object, colCnt, j
Dim xlFile As String, xlPath As String
xlPath = "C:\Program Files\Enterprise\Test\"


xlFile = Dir(xlPath & "*.xls")

While xlFile <> ""
    Set xlObj = CreateObject("excel.application")
        xlObj.workbooks.Open xlPath & xlFile
    'import sheet content to tempTable
     
      With xlObj
      For j = 1 To .Worksheets.Count
     
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        "tempTable", xlPath & xlFile, False, .Worksheets(j).Name & "!B2:T32"
           
           
            CurrentDb.Execute "update temptable set " _
                                    & " [F20]= '" & xlPath & "'" _
                                    & ",[F21]= '" & xlFile & "'" _
                                    & ",[F22]= '" & .Worksheets(j).Name & "'" _
                                    & " Where [F22] is Null"
      Next
     
      End With

        xlObj.Quit
        Set xlObj = Nothing
    xlFile = Dir
Wend
Dim sql

sql = "INSERT INTO tbl_DataInformation ( Project_Date, OffSite_ProjectSize, OffSite_CrossHours, OffSite_ProjAdminHours, OffSite_LinesProcessed, OffSite_Comments, OnSite_CrossHours, OnSite_ProjAdminHours, OnSite_TravelHours, OnSite_LinesProcessed, OnSite_Comments, Training_Hours, Meetings, Holiday, Pto, Other_Admin, Other_Comments, Daily_Total_Hours, Daily_Total_Lines, xlPathName, xlFileName, xlSheetName )"
sql = sql & " SELECT temptable.F1, temptable.F2, temptable.F3, temptable.F4, temptable.F5, temptable.F6, temptable.F7, temptable.F8, temptable.F9, temptable.F10, temptable.F11, temptable.F12, temptable.F13, temptable.F14, temptable.F15, temptable.F16, temptable.F17, temptable.F18, temptable.F19, temptable.F20, temptable.F21, temptable.F22"
sql = sql & " FROM temptable;"

CurrentDb.Execute sql    ', dbFailOnError
'delete contents of temptable
CurrentDb.Execute "delete * from temptable"



Thanks
fordraiders
0
Fordraiders
Asked:
Fordraiders
  • 7
  • 4
1 Solution
 
Rey Obrero (Capricorn1)Commented:
it will be better if you create a table to list the folders and subfolders that you will extract the data from the excel files.. you can achieved that by using the codes in this link


http://allenbrowne.com/ser-59.html


after you built the list, open the table as recordset

dim rs as dao.recordset

set rs=currentdb.openrecordset("Files")

do until rs.eof

    'place the import codes here


rs.movenext
loop
0
 
FordraidersAuthor Commented:
ok...cap...
did what you suggested...however now while during the loop.


xlFile = Dir(xlPath & strFileName)  <---------- this keeps coming up as   ""




Dim xlObj As Object, Sheet As Object, colCnt, j
Dim xlFile As String, xlPath As String
Dim strFileName As String

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Files")
Do Until rs.EOF

xlPath = "C:\Program Files\Crs Enterprise\Test\"

strFileName = rs.Fields(1).Value

xlFile = Dir(xlPath & strFileName)   <---- keeps coming up as "" during debug

While xlFile <> ""
    Set xlObj = CreateObject("excel.application")
        xlObj.workbooks.Open xlPath & xlFile
    'import sheet content to tempTable
     
      With xlObj
      For j = 1 To .Worksheets.Count
     
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        "tempTable", xlPath & xlFile, False, .Worksheets(j).Name & "!B2:T32"
           
           
            CurrentDb.Execute "update temptable set " _
                                    & " [F20]= '" & xlPath & "'" _
                                    & ",[F21]= '" & xlFile & "'" _
                                    & ",[F22]= '" & .Worksheets(j).Name & "'" _
                                    & " Where [F22] is Null"
      Next
     
      End With

        xlObj.Quit
        Set xlObj = Nothing
    xlFile = Dir
Wend
rs.MoveNext
Loop
0
 
Rey Obrero (Capricorn1)Commented:
what is the value for this line

strFileName = rs.Fields(1).Value
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
FordraidersAuthor Commented:
the name of the .xls file in the recordset.
0
 
Rey Obrero (Capricorn1)Commented:
change this

xlFile = Dir(xlPath & strFileName)   <---- keeps coming up as "" during debug

wirh

xlFile = xlPath & strFileName
0
 
FordraidersAuthor Commented:
changed
xlFile  - strFileName
and
xlPath = rs.field(3).value..

However, When I execute the code now...after it imports the data from the first workbook,
I get a prompt to  "Save" "disregard changes" or "cancel"

I hit "cancel"and the code runs...
??


Thanks
fordraiders
0
 
FordraidersAuthor Commented:
sorry cap,
I think I'm thrown in an endless loop here : ?

Dim xlObj As Object, Sheet As Object, colCnt, j
Dim xlFile As String, xlPath As String
Dim strFileName As String

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Files")
Do Until rs.EOF

strFileName = rs.Fields(1).Value

xlPath = rs.Fields(2).Value

xlFile = strFileName

While xlFile <> ""
    Set xlObj = CreateObject("excel.application")
        xlObj.workbooks.Open xlPath & xlFile
    'import sheet content to tempTable
     
      With xlObj
      For j = 1 To .Worksheets.Count
     
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        "tempTable", xlPath & xlFile, False, .Worksheets(j).Name & "!B2:T32"
           
           
            CurrentDb.Execute "update temptable set " _
                                    & " [F20]= '" & xlPath & "'" _
                                    & ",[F21]= '" & xlFile & "'" _
                                    & ",[F22]= '" & .Worksheets(j).Name & "'" _
                                    & " Where [F22] is Null"
      Next
     
      End With

        xlObj.Quit
        Set xlObj = Nothing
  '  xlFile = Dir   <---- commented out
Wend
rs.MoveNext
Loop


Thanks
fordraiders
0
 
Rey Obrero (Capricorn1)Commented:
you don't need to use this loop


While xlFile <> ""      'remove this


  '  xlFile = Dir   <---- commented out
Wend           'remove this
0
 
FordraidersAuthor Commented:
ok this finally did it !

 
       xlObj.ActiveWorkbook.Close False
         xlObj.Quit
        Set xlObj = Nothing
   xlFile = ""
0
 
FordraidersAuthor Commented:
who ever reads this needs to read the whole thread please...
Thanks
Cap
0
 
FordraidersAuthor Commented:
cap , here is the complete code...
unless you tell me it needs tyding up a bit..

it does work..

Sub importexcel3()
Dim xlObj As Object, Sheet As Object, colCnt, j
Dim xlFile As String, xlPath As String
Dim strFileName As String

Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("Files")
Do Until rs.EOF

 strFileName = rs.Fields(1).Value
   xlPath = rs.Fields(2).Value
    xlFile = strFileName

While xlFile <> ""
    Set xlObj = CreateObject("excel.application")
         xlObj.Visible = False
        xlObj.workbooks.Open xlPath & xlFile
    'import sheet content to tempTable
      With xlObj
      For j = 1 To .Worksheets.Count
     
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        "tempTable", xlPath & xlFile, False, .Worksheets(j).Name & "!B2:T32"
            CurrentDb.Execute "update temptable set " _
                                    & " [F20]= '" & xlPath & "'" _
                                    & ",[F21]= '" & xlFile & "'" _
                                    & ",[F22]= '" & .Worksheets(j).Name & "'" _
                                    & " Where [F22] is Null"
      Next
      End With
       xlObj.ActiveWorkbook.Close False
        xlObj.Quit
         Set xlObj = Nothing
           xlFile = ""
Wend

rs.MoveNext
Loop
'---------------------------------------------------
Dim sql
sql = "INSERT INTO tbl_DataInformation ( Project_Date, OffSite_ProjectSize, OffSite_CrossHours, OffSite_ProjAdminHours, OffSite_LinesProcessed, OffSite_Comments, OnSite_CrossHours, OnSite_ProjAdminHours, OnSite_TravelHours, OnSite_LinesProcessed, OnSite_Comments, Training_Hours, Meetings, Holiday, Pto, Other_Admin, Other_Comments, Daily_Total_Hours, Daily_Total_Lines, xlPathName, xlFileName, xlSheetName )"
sql = sql & " SELECT temptable.F1, temptable.F2, temptable.F3, temptable.F4, temptable.F5, temptable.F6, temptable.F7, temptable.F8, temptable.F9, temptable.F10, temptable.F11, temptable.F12, temptable.F13, temptable.F14, temptable.F15, temptable.F16, temptable.F17, temptable.F18, temptable.F19, temptable.F20, temptable.F21, temptable.F22"
sql = sql & " FROM temptable;"

CurrentDb.Execute sql    ', dbFailOnError
'delete contents of temptable
CurrentDb.Execute "delete * from temptable"

rs.Close
Set rs = Nothing
End Sub
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

  • 7
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now