Link to home
Start Free TrialLog in
Avatar of tim_cs
tim_csFlag for United States of America

asked on

Import Excel file to Access Table

I need to import data from an excel file into an access table.  I will need to import only certain columns from the excel file, columns A C D and E,  but all of the rows that have data from all of the sheets.  The needed columns will be the same for each sheet.  

I know I can use the DoCmd.TransferSpreadsheet but how do I import each sheet and only the columns that I need?  The number of sheets each time could change.

This is for Access 2000 DB.
Avatar of Mike Eghtebas
Mike Eghtebas
Flag of United States of America image

With:

DoCmd.TransferSpreadsheet ...

you can specify it sheet and range also. But, a much prefered way is to process one record at a time and test each data point (validate) before commiting it to the database table.  This I say because Excel worksheet often have some bad data (where you could produce an exception report to inform what records weren't imported and why).

If you are interested in the solution I can start diging through my notes to work with you. Also, I would like have this refresher practice myself. Please let me know about it.

Mike

Avatar of Natchiket
Hi tim

If the data is contiguous and starts in cell A1 then you can use a routine based on the the following.  You will need the Excel Object Library and the DAO Library in project references.
I'm going to assume that the table is called tblTable and the columns in the table are called ColA,ColC,ColD,ColE, also that there are no column headings in the excel worksheets

Dim xlAPP as Excel.Application
Dim xlWkb as Excel.Workbook
Dim xlWks as Excel.Worksheet
Dim rng as Excel.Range
Dim rngRow as Excel.Range
Dim strSQL as String
Dim db as DAO.database
Dim varA,varC,varD,varE     'Holders for the column values


Set xlApp = New Excel.Application
Set xlWkb = xlApp.Open(Filename:="Full Path of your excel file goes here")

Set db = CurrentDb()

'Iterate through all the worksheets
For each xlWks in xlWkb.Worksheets

 Set rng = xlWks.Cells(1,1).CurrentRegion     'get the range indicated by the current region
 
 'Iterate through all the rows in the current region
 For each rngRow in rng.Rows
   
   'Get the values from each column
   varA = rngRow.Column(1)
   varC = rngRow.Column(3)
   varD = rngRow.Column(4)
   varE = rngRow.Column(5)
 
   'Set up the SQL to append the row to the table
   strSQL = "INSERT INTO tblTable(ColA,ColC,ColD,ColE) "
   strSQL = strSQL & "VALUES ("
   strSQL = strSQL & IIF(ISNULL(varA),"NULL",varA) & ","    'NB if the field being appended to is text it should be IIF(ISNULL(varA),"NULL","'" & varA & "'")
   strSQL = strSQL & IIF(ISNULL(varC),"NULL",varC) & ","    'or if the field is date/time then IIF(ISNULL(varA),"NULL","#" & Format(varA,"dd/mmm/yyyy") & "#")
   strSQL = strSQL & IIF(ISNULL(varD),"NULL",varD) & ","
   strSQL = strSQL & IIF(ISNULL(varE),"NULL",varE) & ")"

   'Append the row
   db.Execute strSQL

 Next    'Next row in the range

Next    'Next worksheet in the workbook

'Tidy up and close down
Set rngRow = Nothing
Set rng = Nothing
Set xlWks = Nothing
xlWkb.Close
Set xlWkb = nothing
xlApp.Quit
Set xlApp = Nothing

Obviously I have made certain assumptions here, but it should be enough of a framework to get you going!
Hope this helps,

Nat
Another way is to link each sheet as a linked table then u can create sql that way
or u can use ADO to talk to your xls file

eg - sample module which can be placed in any vba module

public function ReadXLSFile
    Dim adoConn As adodb.Connection
    Dim adoRS As adodb.Recordset
    Dim sConn As String
    Dim sSql as String
   
    Set adoConn = New adodb.Connection

'Set HDR=1 if xls file contains headers, change path to your file
    sConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=C:\myfile.xls;Extended Properties='Excel 8.0;HDR=1'"
    adoConn.Open sConn
   
'Given a aconnection you can now create recordsets based on a sheet - treat each sheet as a table
    Set adoRS = New adodb.Recordset
    adoRS.Open "SELECT * FROM [Sheet2$]", adoConn
    Do While adoRS.EOF = False

'Display col C,D and E
        Debug.Print adoRS.Fields(2).Value,adoRS.Fields(3).Value,adoRS.Fields(4).Value

'Can write your insert statement here
'Note, if string field, ensure u wrap with single quotes like field1 and field2
'otherwise no single quotes like field3

        sSql = "INSERT INTO newtable (field1,field2,field3) VALUES ('" & adoRS.Fields(2).Value & "','" & adoRS.Fields(3).Value & "'," & adoRS.Fields(4).Value & ")"

        currentdb.execute sSql
        adoRS.MoveNext
    Loop

    adoRS.Close
    Set adoRS = Nothing
    adoConn.Close
    Set adoConn = Nothing
end function


Now all u need to do is define a recordset for each sheet


If the file contains headers, u can use that as the fieldname
eg

adoRS!headerfieldname

instead of referencing the column

adoRS.Fields(2).Value

Avatar of tim_cs

ASKER

eghtebas  I'm up for testing any suggestions that are made.

I'm testing out the current suggestions now.  One of my main concerns with going row by row is going to be speed.  I will be going through a little over 100,000 rows on average.  
Well I can tell you now that my solution will be quite slow!
Your best bet is probably a combination of finding out the worksheets in the workbook, then either use rockiroads solution, or just dump the worksheets into a table using TransferSpreadsheet and then use a query to append the fields you need to the target table.
Avatar of tim_cs

ASKER

Just wanted to say thanks to everybody for the suggestions.  I worked with Natchiket's suggestion to start with and was able to get it to a point where it looked like it was working.  But I had to leave work before it finished, looks like it would be at least 30 minutes or so to complete doing it that way.  Unfortunately I am out of the office for the next several days but I will get back to this as soon as I'm back at work.  

Once again thank you to everyone who has contributed so far.  
Avatar of tim_cs

ASKER

I've tested out the provided solutions and unfortunately they are taking way to long, on average between 30 minutes and 1 1/2 hours.  Looks like I'm just going to have to use the TransferSpreadsheet method to import to a temp table then move the needed information to the actual table.

How can a figure out the number of (and possibly name of) the sheets in a workbook?  Also, with that many rows any suggestions for the quickest way of transferring the needed data from the temp table to the permanent table that I might not think of?

Thanks for all the help so far.  
ASKER CERTIFIED SOLUTION
Avatar of Natchiket
Natchiket
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I'd suggest a good old append query for moving data from the temporary tables to the permananent tables
oops

For each xlWks In xlWkb
 strSheets = strSheets & xlWks.Name & ";"
Next

should be

For each xlWks In xlWkb.Worksheets
 strSheets = strSheets & xlWks.Name & ";"
Next
Here's another solution - uses ADOX to read the Sheet names - and this should be quick......

2 subs - the second does the reading of sheetnames and transferspreadsheet method for each one - ensure that your table name and your range for where your Excel data is, is correct. We import the whole sheet to the temp table, then append to the main the columns we need.


**Need to set references in your VBE to ActiveX Data Objects Ext. For DDL and Security (ADOX) and ActiveX Data Objects 2.x Library**

Sub myImport()

DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM tempDATA"
ReadSheetNames "C:\myPath\Book1.xls"
DoCmd.RunSQL "INSERT INTO mainDATA (colA,colC,colD,colE) SELECT colA,colC,colD,colE FROM tempDATA"
DoCmd.SetWarnings True

End Sub


Sub ReadSheetNames(WB As String)
Dim cnn As New ADODB.Connection
Dim cat As New ADOX.Catalog
Dim tbl As ADOX.Table

'cnn.Open "Provider=MSDASQL.1;Data Source=" _
' & "Excel Files;Initial Catalog=" & WB
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & WB & ";Extended Properties=Excel 8.0"
 
cat.ActiveConnection = cnn
For Each tbl In cat.Tables
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tempDATA", WB, True, "" & Replace(tbl.Name, Chr(39), "", 1, 2) & "A1:E10000"
Next tbl

Set cat = Nothing
cnn.Close
Set cnn = Nothing
End Sub
Avatar of BBRRGG
BBRRGG

I tried Natchiket's first suggestion but when I try to run the code I get a compile error: "Wrong number of arguments or invalid assignment (Error 450)."  

It occurs at the following line:
varA = rngRow.Column(1)

Any suggestions?