Solved

Import all Excel sheets into the same table

Posted on 2011-02-23
27
455 Views
Last Modified: 2013-11-27
I have an Excel workbook that can have multiple sheets. The data on the sheets are formatted exactly the same. Right now the user is copying the extra sheets to sheet one and importing it into the DB. I want to allow them to just import it all at once without having to do that. I found, here on EE, an example that uses a combobox to allow them to select what they want imported. I couldn't get it to work to just import everything.  Here is the code I am currently using - this actually allows them to grab multilple Excel files as well. I just want one file, but all sheets in that file. Thanks for any help you can give me. I truly appreciate it.
 
Dim fdg As FileDialog, vrtSelectedItem As Variant
    Dim strSelectedFile As String
    
    Set fdg = Application.FileDialog(msoFileDialogFilePicker)
    fdg.InitialFileName = DLookup("DefaultDir", "defLocation")
    
    With fdg
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls"
        .Filters.Add "Excel 2007", "*.xlsx"
        .AllowMultiSelect = True
        .InitialView = msoFileDialogViewDetails
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
            strSelectedFile = vrtSelectedItem
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Scrap", strSelectedFile, True, , False
        Next vrtSelectedItem
        Else
        End If
'        If Not IsEmpty(strSelectedFile) Then
        If Len(Trim(strSelectedFile) & "") > 0 Then
        
        
        DoCmd.OpenForm "UpdateTables", , , , , , False
        DoCmd.Close acForm, "ScrapAnalysis", acSaveNo
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "Scrap Query"
        DoCmd.OpenQuery "minDate"
        DoCmd.OpenQuery "maxDate"
        
        DoCmd.SetWarnings True
        Else
        DoCmd.OpenForm "FileNotSelected", acNormal, , , , , False
        End If
'        DoCmd.Requery "Reasons"
'        DoCmd.Requery "ToolNumbers"
'        Me.cboReason.Requery
'        Me.cboTool.Requery
        
        
        

        
    End With

Open in new window

0
Comment
Question by:G Scott
  • 10
  • 9
  • 8
27 Comments
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 34960683

test this codes

see the Sub ImportAllSheets(xlFile) added to the codes
Dim strSelectedFile As String
    
    Set fdg = Application.FileDialog(msoFileDialogFilePicker)
    fdg.InitialFileName = DLookup("DefaultDir", "defLocation")
    
    With fdg
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls"
        .Filters.Add "Excel 2007", "*.xlsx"
        .AllowMultiSelect = True
        .InitialView = msoFileDialogViewDetails
        If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
            strSelectedFile = vrtSelectedItem
 '           DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Scrap", strSelectedFile, True, , False
 
            Call ImportAllSheets(strSelectedFile)



	   Next vrtSelectedItem
        Else
        End If
'        If Not IsEmpty(strSelectedFile) Then
        If Len(Trim(strSelectedFile) & "") > 0 Then
        
        
        DoCmd.OpenForm "UpdateTables", , , , , , False
        DoCmd.Close acForm, "ScrapAnalysis", acSaveNo
        DoCmd.SetWarnings False
        DoCmd.OpenQuery "Scrap Query"
        DoCmd.OpenQuery "minDate"
        DoCmd.OpenQuery "maxDate"
        
        DoCmd.SetWarnings True
        Else
        DoCmd.OpenForm "FileNotSelected", acNormal, , , , , False
        End If
'        DoCmd.Requery "Reasons"
'        DoCmd.Requery "ToolNumbers"
'        Me.cboReason.Requery
'        Me.cboTool.Requery
        
        
        

        
    End With

----------------------------------------



Sub ImportAllSheets(xlFile)
dim xlObj as object, j as integer
set xlobj=createobject("excel.application")
    xlobj.workbooks.open xlfile
    with xlobj
    for j=1 to .worksheets.count
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Scrap", xlFile, True,.worksheets(j).name & "!", False
         

    next 
    end with
    xlobj.quit
    set xlObj=nothing
end sub

Open in new window

0
 
LVL 10

Expert Comment

by:conagraman
ID: 34961003
here is a way to do that using the transferspreadsheet method.
i have also attached a sample database to look at


'--------------------requires ref to microsoft excel object library
On Error Resume Next
Dim appExcel As Excel.Application
Dim wb As Excel.Workbook
Dim sh As Excel.Worksheet
Dim strValue As String
Dim intRow As Integer
Dim intCol As Integer

Set appExcel = CreateObject("Excel.Application")
Set wb = appExcel.Workbooks.Open(Me.txtPath)

If CurrentDb.TableDefs("tblTemp").Name = "tblTemp" Then
DoCmd.DeleteObject acTable, "tblTemp"

                        End If

For Each sh In wb.Sheets
DoCmd.TransferSpreadsheet acImport, , "tblTemp", Me.txtPath, True, sh.Name & "!"
Next

wb.Close
appExcel.Quit
ImportExcel.accdb
0
 
LVL 10

Expert Comment

by:conagraman
ID: 34961008
capricorn1:
i posted that before i saw your post - my bad
0
 
LVL 10

Expert Comment

by:conagraman
ID: 34961041
on my code you dont need the last three variables
Dim strValue As String
Dim intRow As Integer
Dim intCol As Integer

0
 
LVL 1

Author Comment

by:G Scott
ID: 34961186
capricorn1 - I tested your code and it seems to work, however it errors out and says that a field I am importing doesn't exist in the destination table. On further inspection of my Excel sheet, the second sheet doesn't have field names but the data is structured the same as the first sheet. :( That is probably what is causing that error, correct? Is there any way to fix that?

conagraman - when I use your sample, I still only get 16383 records in the table
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 34961242
<the second sheet doesn't have field names but the data is structured the same as the first sheet>  
this is really causing the error

you can read the first row of the sheet and toggle the codes to import without column names

post sample of the excel file.
0
 
LVL 1

Author Comment

by:G Scott
ID: 34961324
Here is a sample of what I am working with. The first sheet has 16383 records and then it spills over into sheet two or three, depending on what date range you select in your report.

Thanks for taking a look at it for me.

 SampleSpreadsheet.xls
0
 
LVL 10

Expert Comment

by:conagraman
ID: 34961527
it does seem to be the formatting of the spreadsheet.

what does seem to work is to change the true to false in the transfer spreadsheet command
what this does is your telling it not to look for the column names.
the only problem in doing this is the column names are imported anyway into a record.
either add the column names to spreadsheet two or change the true to false

DoCmd.TransferSpreadsheet acImport, , "tblTemp", Me.txtPath, false, sh.Name & "!"
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 34961542
try this revised codes


Sub ImportAllSheets(xlFile)
Dim xlObj As Object, j As Integer, xlSht As Object
xlFile = CurrentProject.Path & "\sampleSpreadsheet.xls"
Set xlObj = CreateObject("excel.application")
    xlObj.workbooks.Open xlFile
    With xlObj
    For j = 1 To .worksheets.Count
        Set xlSht = .activeworkbook.worksheets(j)
        If IsNumeric(xlSht.cells(1, 1).Value) Then
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Scrap", xlFile, False, .worksheets(j).Name & "!", False
        
        Else
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Scrap", xlFile, True, .worksheets(j).Name & "!", False
         
        End If
    Next
    End With
    xlObj.Quit
    Set xlObj = Nothing
End Sub

Open in new window

0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 34961556
use this code, ignore the one above



Sub ImportAllSheets(xlFile)
Dim xlObj As Object, j As Integer, xlSht As Object

Set xlObj = CreateObject("excel.application")
    xlObj.workbooks.Open xlFile
    With xlObj
    For j = 1 To .worksheets.Count
        Set xlSht = .activeworkbook.worksheets(j)
        If IsNumeric(xlSht.cells(1, 1).Value) Then
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Scrap", xlFile, False, .worksheets(j).Name & "!", False
        
        Else
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Scrap", xlFile, True, .worksheets(j).Name & "!", False
         
        End If
    Next
    End With
    xlObj.Quit
    Set xlObj = Nothing
End Sub

Open in new window

0
 
LVL 1

Author Comment

by:G Scott
ID: 34961569
Hmmm..I am getting an '2391' with 'Field F1 doesn't exist....'
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 34961626
ExpertOnNothing,

the column names in your excel file have carriage return  or line feed, you need to correct this.

what are the field names in your table Scrap?

0
 
LVL 1

Author Comment

by:G Scott
ID: 34961696
See, therein lies the problem. That Excel file is generated by our corporate offices as a Cognos report and can't be changed. When I initially started this project I had to manipulate the field names to reflect the spreadsheet. Attached is the actual database. ScrapAnalysis.accdb
0
Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

 
LVL 1

Author Comment

by:G Scott
ID: 34961707
The VBA password is GoBlue2010...sorry, forgot to turn that off.
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 34961740
please create a blank .mdb file, import all the objects to it from the .accdb

upload the .mdb
0
 
LVL 1

Author Comment

by:G Scott
ID: 34961868
Thanks capricorn1.

I am very ashamed of this DB so don't hold too much against me. It was the first one that I ever did.
ScrapAnalysis2.mdb
0
 
LVL 119

Accepted Solution

by:
Rey Obrero earned 500 total points
ID: 34962007
don't bother, use this codes  to fix your excel file
this will remove the cr, lf from the Column name and save as a new copy of the excel file that you can import without problem in the field names..



Sub fixExcel()
Dim xlObj As Object, j As Integer, iCol As Integer
Dim xlSht As Object, xlFile
xlFile = CurrentProject.Path & "\sampleSpreadsheet.xls"
Set xlObj = CreateObject("excel.application")
    xlObj.workbooks.Open xlFile
    With xlObj
        Set xlSht = .activeworkbook.worksheets(1)
            With xlSht
                For iCol = 1 To .usedrange.columns.Count
                    .cells(1, iCol).Value = _
                    Replace(Replace(Replace(.cells(1, iCol), Chr(13) & Chr(10), ""), Chr(13), ""), Chr(10), "")
                Next
            End With

    .activeworkbook.saveas CurrentProject.Path & "\sampleSpreadsheetRev.xls"
    End With
    xlObj.Quit
End Sub

Open in new window

0
 
LVL 10

Expert Comment

by:conagraman
ID: 34962580
Capricorn1

i think the problem is bigger than that.  i ran into the field formatting in the table vrs the spreadsheet fields being an issue.  i dont know if code is going to fix this completely.
the closest i could get is this.

ExpertOnNothing:

i have the code dump the records in a temp table then i run an append query to move the files to the scrap table and then a delete query to remove the files from the temp table; of course you could just delete the table after each use but i wanted to leave it so you can see what is going on. that is also the reason for not performing my queries in code. the code below requires two references
the first reference is to the
Microsoft excel 12.0 object library
and
Microsoft Office 12.0 Object Library.

so in your actual database set the references. then import the "tblTemp" "qryUpdateScrap" and "qryDeleteTblTempData" from the sample database i have uploaded. Next copy the following code into a button on your ScrapAnalysis form or wherever you want the code to run. I have the code in your comand151 button on your scrapanalysis form

ScrapAnalysis2.mdb
0
 
LVL 10

Expert Comment

by:conagraman
ID: 34962621
On Error Resume Next
   Dim MyFilePath As String
   Dim MyFileDialog As Office.FileDialog
   Dim MyfileDFilter As Office.FileDialogFilter
   Dim strPath As String
   Dim appExcel As Excel.Application
   Dim wb As Excel.Workbook
   Dim sh As Excel.Worksheet
   
   Set MyFileDialog = Application.FileDialog(msoFileDialogFilePicker)

   With MyFileDialog
      .Title = "Select Excel File"
      .Filters.Clear
      .Filters.Add "Excel Files", "*.xlsx, *.xls"
      .FilterIndex = 2
      .ButtonName = "Select"
      .InitialView = msoFileDialogViewDetails

      If .Show = -1 Then
         MyFilePath = CStr(MyFileDialog.SelectedItems.Item(1))
      Else
       
      End If
   End With

   Set appExcel = CreateObject("Excel.Application")
   Set wb = appExcel.Workbooks.Open(MyFilePath)
   appExcel.Visible = False
   For Each sh In wb.Sheets
        DoCmd.TransferSpreadsheet acImport, , "tblTemp", MyFilePath, False, sh.Name & "!"
   Next
   wb.Close
   appExcel.Quit
   DoCmd.SetWarnings False
   DoCmd.OpenQuery "qryUpdateScrap"
   DoCmd.OpenQuery "qryDeleteTblTempData"
   DoCmd.SetWarnings True
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 34962639
<
i think the problem is bigger than that.  i ran into the field formatting in the table vrs the spreadsheet fields being an issue.
>

after fixing the column names, delete table scrap and import the excel file to create new table with the correct field names.
0
 
LVL 10

Expert Comment

by:conagraman
ID: 34962669
oh my bad.
0
 
LVL 10

Expert Comment

by:conagraman
ID: 34962682
i forgot -

i believe the only issue with that is the forms and queries in his program are based off the old table field names
0
 
LVL 1

Author Closing Comment

by:G Scott
ID: 34962687
Thanks capricorn! It worked perfectly.
0
 
LVL 10

Expert Comment

by:conagraman
ID: 34962693
so as soon as you open the form scrapanalysis you would get an error. ?
0
 
LVL 1

Author Comment

by:G Scott
ID: 34962787
No, if you are looking at my actual DB, when I would click the Command151 button.
0
 
LVL 10

Expert Comment

by:conagraman
ID: 34962863
ok im glad it worked
0
 
LVL 1

Author Comment

by:G Scott
ID: 34962896
Sorry conagraman, I didn't see your posts before I replied to capricorn. Your example worked perfectly too.
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Regardless of which version on MS Access you are using, one of the harder data-entry forms to create is one where most data from previous entries needs to be appended to new records, especially when there are numerous fields and records involved.  W…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

706 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now