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

combine several workbooks and all sheets into one access table

access 2010
vba code needed
excel /2003/2010

I need to loop through each workbook and each worksheet(in each workbook) in the 4 subfolders. and in the data range specified below.

I have 2 fields in the table that have to be updated also.

Supervisor = the name of the each subfolder
Associate = the name of the excel file


Databasename = LogFile.accdb
tablename = tbl_Datainformation

field name :
ID_ProdLog =autonumber
Supervisor
Associate
Project_Date = date/time
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

all the rest of the field are text

main path
C:\LOG\

SUB FOLDER NAMES:(supervisor names)

W_Team_Werve
SE_Team_West
NE_Team_Theodorovich
MW_Team_Cavalier

SEVERAL WORKBOOKS IN EACH FOLDER(associate names)
usually like this format:
W - SOTELO Louis - Productivity Log 2012.xls
MW - hull bill - Productivity Log 2012.xls


DATA RANGE: for each worksheet
B2:T32

I only need the data in this cell range.

The field mapping per image file attached




Thanks very much
fordraiders

here is some code i have used for other purposes but:

1. does not loop through each subfolder
2. does not loop through each sheet
3..the range is not defined specifically

I do not need a temptable anymore.



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


xlFile = Dir(xlPath & "*.xls")
While xlFile <> ""
    Set xlObj = CreateObject("excel.application")
        xlObj.workbooks.Open xlPath & xlFile
    'import sheet content to tempTable
       DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        "tempTable", xlPath & xlFile, True, "shtFinished!B:K"
        xlObj.Quit
        Set xlObj = Nothing
    xlFile = Dir
Wend
Dim sql
sql = "INSERT INTO tblNewImportMonthly ( fldImportTag, fldImportName, fldImportComments, fldImportDesc, fldImportDesc2, fldImportDesc3, fldXref, fldType )"
sql = sql & " SELECT TAG, [NEW WWG], XREFTYPE, COMMENTS, [CUSTOMER DESC], ITEM, XREFTYPE1, COMMENTS1"
sql = sql & " FROM tempTable;"
CurrentDb.Execute sql, dbFailOnError
'delete contents of temptable
CurrentDb.Execute "delete * from temptable"
End Sub
databasedesign.png
0
Fordraiders
Asked:
Fordraiders
  • 8
  • 5
1 Solution
 
Rey Obrero (Capricorn1)Commented:
you can start the project with the code that lists files recursively from this link


http://allenbrowne.com/ser-59.html
0
 
FordraidersAuthor Commented:
I've requested that this question be deleted for the following reason:

The requirements have changed on me and little participation. I know this is a common question, but going to have to go back and revise my question. Just need to delete please.
0
 
FordraidersAuthor Commented:
sorry, to quick to delete..requesting attention from capricorn1 again..
0
Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

 
FordraidersAuthor Commented:
cap, reference to an earlier question in 2008...


http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_23216827.html



but I need it to loop through every worksheet in every workbook.
0
 
FordraidersAuthor Commented:
but still wit specification as above.
looping through folders and only a specific range.
DATA RANGE: for each worksheet
B2:T32

I only need the data in this cell range.
0
 
Rey Obrero (Capricorn1)Commented:
try this codes



Dim xlObj As Object, Sheet As Object, colCnt, j
Dim xlFile As String, xlPath As String
xlPath = "C:\Program Files\ImportExcel\"


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

While xlFile <> ""
    Set xlObj = CreateObject("excel.application")
        xlObj.workbooks.Open xlPath & xlFile
    'import sheet content to tempTable
      
      With objXL
      for j = 1 to .worksheets.count
      
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        "tempTable", xlPath & xlFile, True, .worksheets(j).name & "!B:K"      
      
      next
      
      end with
'               DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
                  "tempTable", xlPath & xlFile, True, "shtFinished!B:K"
                  
        xlObj.Quit
        Set xlObj = Nothing
    xlFile = Dir
Wend
0
 
Rey Obrero (Capricorn1)Commented:
change this

      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        "tempTable", xlPath & xlFile, True, .worksheets(j).name & "!B:K"      

with


      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        "tempTable", xlPath & xlFile, True, .worksheets(j).name & "!B2:T32"
0
 
FordraidersAuthor Commented:
cap trying to help here as much as I can.

getting the data into the temptable just fine. however..

FOR EACH WORKSHEET:IN EACH WORKBOOK:
I still need to add the workbook name it came from:
and the folder it came from ?

which now would be fields F18, F19  in the temptable



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


xlFile = Dir(xlPath & "*.xls")
While xlFile <> ""
    Set xlObj = CreateObject("excel.application")
        xlObj.workbooks.Open xlPath & xlFile
    'import sheet content to tempTable
       DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        "tempTable", xlPath & xlFile, False, "September!B2:T32"
        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)"
sql = sql & " SELECT F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11,F12,F13,F14,F15,F16,F17"
sql = sql & " FROM tempTable;"
CurrentDb.Execute sql, dbFailOnError
'delete contents of temptable
CurrentDb.Execute "delete * from temptable"
End Sub
0
 
FordraidersAuthor Commented:
sorry was typing did not see your posts..
0
 
Rey Obrero (Capricorn1)Commented:
<I still need to add the workbook name it came from:
and the folder it came from ?>

how about the name of the worksheet ?
0
 
FordraidersAuthor Commented:
yes that also , sorry

and is this correct ?

With objXL
      for j = 1 to .worksheets.count

Thanks
fordraiders
0
 
Rey Obrero (Capricorn1)Commented:
you need to add F20 to your temptable

Dim xlObj As Object, Sheet As Object, colCnt, j
Dim xlFile As String, xlPath As String
xlPath = "C:\Program Files\ImportExcel\"


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

While xlFile <> ""
    Set xlObj = CreateObject("excel.application")
        xlObj.workbooks.Open xlPath & xlFile
    'import sheet content to tempTable
      
      With objXL
      for j = 1 to .worksheets.count
      
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        "tempTable", xlPath & xlFile, True, .worksheets(j).name & "!B32:T32"      
            
            
            currentdb.execute "update temptable set " _
                                    & " [F18]= '" & xlPath & "'" _
                                    & ",[F19]= '" & xlFile & "'" _
                                    & ",[F20]= '" & .worksheets(j).name & "'" _
                                    & " Where [F20] is Null"
      
      next
      
      end with

                  
        xlObj.Quit
        Set xlObj = Nothing
    xlFile = Dir
Wend
0
 
FordraidersAuthor Commented:
arrugh, I should know the update within the loop by now...sorry for the bother and Thanks for staying with the question. Very much !
0

Featured Post

Upgrade your Question Security!

Add Premium security features to your question to ensure its privacy or anonymity. Learn more about your ability to control Question Security today.

  • 8
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now