Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 632
  • 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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
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

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

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