importing multiple sheets as separate tables in Access

[DrOktagon]

Any help is appreciated.

Starting with an Excel book containing many sheets, I'd like to have a macro that imports each sheet as a separate table in Access.

Thanks a lot!

 

[Trevor G]

Try this

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> allExcelSheetsBooks()<br><SPAN style="color:#007F00">'Copy this code into a module in Access</SPAN><br><SPAN style="color:#007F00">'Open the database then use Alt + F11</SPAN><br><SPAN style="color:#007F00">'Select the Insert menu and Module</SPAN><br><br><SPAN style="color:#00007F">Dim</SPAN> blnHasFieldNames <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>, blnEXCEL <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>, blnReadOnly <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> lngCount <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> objExcel <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN>, objWorkbook <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> colWorksheets <SPAN style="color:#00007F">As</SPAN> Collection<br><SPAN style="color:#00007F">Dim</SPAN> strPathFile <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> strPassword <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><br><SPAN style="color:#007F00">' Establish an EXCEL application object</SPAN><br><SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br><SPAN style="color:#00007F">Set</SPAN> objExcel = GetObject(, "Excel.Application")<br><SPAN style="color:#00007F">If</SPAN> Err.Number <> 0 <SPAN style="color:#00007F">Then</SPAN><br>      <SPAN style="color:#00007F">Set</SPAN> objExcel = CreateObject("Excel.Application")<br>      blnEXCEL = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>Err.Clear<br><SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br><br><SPAN style="color:#007F00">' Change this next line to True if the first row in EXCEL worksheet</SPAN><br><SPAN style="color:#007F00">' has field names</SPAN><br>blnHasFieldNames = <SPAN style="color:#00007F">True</SPAN><br><br><SPAN style="color:#007F00">' Replace C:\Filename.xls with the actual path and filename</SPAN><br>strPathFile = "M:\access files\tblStaff Import.xls"<br><br><SPAN style="color:#007F00">' Replace passwordtext with the real password;</SPAN><br><SPAN style="color:#007F00">' if there is no password, replace it with vbNullString constant</SPAN><br><SPAN style="color:#007F00">' (e.g., strPassword = vbNullString)</SPAN><br>strPassword = vbNullString<br><br>blnReadOnly = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#007F00">' open EXCEL file in read-only mode</SPAN><br><br><SPAN style="color:#007F00">' Open the EXCEL file and read the worksheet names into a collection</SPAN><br><SPAN style="color:#00007F">Set</SPAN> colWorksheets = <SPAN style="color:#00007F">New</SPAN> Collection<br><SPAN style="color:#00007F">Set</SPAN> objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _<br>      strPassword)<br><SPAN style="color:#00007F">For</SPAN> lngCount = 1 <SPAN style="color:#00007F">To</SPAN> objWorkbook.Worksheets.Count<br>      colWorksheets.Add objWorkbook.Worksheets(lngCount).Name<br><SPAN style="color:#00007F">Next</SPAN> lngCount<br><br><SPAN style="color:#007F00">' Close the EXCEL file without saving the file, and clean up the EXCEL objects</SPAN><br>objWorkbook.Close <SPAN style="color:#00007F">False</SPAN><br><SPAN style="color:#00007F">Set</SPAN> objWorkbook = <SPAN style="color:#00007F">Nothing</SPAN><br><SPAN style="color:#00007F">If</SPAN> blnEXCEL = <SPAN style="color:#00007F">True</SPAN> <SPAN style="color:#00007F">Then</SPAN> objExcel.Quit<br><SPAN style="color:#00007F">Set</SPAN> objExcel = <SPAN style="color:#00007F">Nothing</SPAN><br><br><SPAN style="color:#007F00">' Import the data from each worksheet into a separate table</SPAN><br><SPAN style="color:#00007F">For</SPAN> lngCount = colWorksheets.Count <SPAN style="color:#00007F">To</SPAN> 1 <SPAN style="color:#00007F">Step</SPAN> -1<br>      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _<br>            "tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, _<br>            colWorksheets(lngCount) & "$"<br><SPAN style="color:#00007F">Next</SPAN> lngCount<br><br><SPAN style="color:#007F00">' Delete the collection</SPAN><br><SPAN style="color:#00007F">Set</SPAN> colWorksheets = <SPAN style="color:#00007F">Nothing</SPAN><br><br><SPAN style="color:#007F00">' Uncomment out the next code step if you want to delete the</SPAN><br><SPAN style="color:#007F00">' EXCEL file after it's been imported</SPAN><br><SPAN style="color:#007F00">' Kill strPathFile</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>

 

[DrOktagon]

Trevor,

I just tried it out and your code is so well commented and works perfect. Thank you very much. One question if I may, can this be altered so that all fields in every table are set to the memo format on import? Otherwise my cells truncate at 255 characters (and some cells have many thousands)

Thanks

 

[Trevor G]

Pleased to read it helped you.

With regards the memo fields having done a little reading here is a couple of suggestions.

The truncated text string that you see is because Jet (ACCESS) sees only "short text" (text strings no longer than 255 characters) values in the first 8 - 25 rows of data in the EXCEL sheet, even though you have longer text farther down the rows. What ACCESS and Jet are doing is assuming that the "text" data actually are Text data type, not Memo data type. One of these suggestions should fix the problem:​

1) Insert a dummy row of data as the first row, where the dummy row contains a text string longer than 255 characters in the cell in that column -- that should let Jet (ACCESS) treat that column's values as memo and not text.
2) Create a blank table into which you will import the spreadsheet's data. For the field that will receive the "memo" data, make its data type "Memo". Jet (ACCESS) then will "honor" the field's datatype when it does the import.​

 

[DrOktagon]

Thanks Again.

1) does not work, the type is automatically set to text regardless of the number of charceters.

2) Is there a way to include this in the macro code?

 

[Trevor G]

The code would have to create the table first and field names and data type then upload the sheet data into the table.

Can you show the sheet first row which gives the headings and then state which one should be memo fields.

 

[Trevor G]

This code will create a table, name the fields and add the Field Type.

This can be adapted to use Cell IDS etc

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> AccessTables()<br><SPAN style="color:#007F00">'References to use MS Access and DAO have to be set</SPAN><br><SPAN style="color:#007F00">'Select the Tools Menu and References</SPAN><br><SPAN style="color:#007F00">'Then scroll down to Microsoft Access and Tick the box</SPAN><br><SPAN style="color:#007F00">'Then scroll down until Microsoft DAO and Tick the box</SPAN><br><br><SPAN style="color:#00007F">Dim</SPAN> db <SPAN style="color:#00007F">As</SPAN> DAO.Database<br><SPAN style="color:#00007F">Dim</SPAN> tdf <SPAN style="color:#00007F">As</SPAN> DAO.TableDef<br><SPAN style="color:#00007F">Dim</SPAN> tdfNew <SPAN style="color:#00007F">As</SPAN> TableDef<br><SPAN style="color:#00007F">Set</SPAN> db = OpenDatabase("M:\Access Files\Test ME Today.mdb")<br><SPAN style="color:#00007F">With</SPAN> db<br>    <SPAN style="color:#007F00">'Create new table</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> tdfNew = db.CreateTableDef("Stuff Today")<br>    <SPAN style="color:#007F00">'Append Fields to new table</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> tdfNew<br>        .Fields.Append .CreateField("EmployeeID", dbLong)<br>        .Fields.Append .CreateField("Hobbies", dbMemo)<br>        .Fields.Append .CreateField("Vacation", dbText, 20)<br>        .Fields.Append .CreateField("AnnualBonus", dbCurrency)<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    .TableDefs.Append tdfNew<br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> tdf <SPAN style="color:#00007F">In</SPAN> .TableDefs<br>    Debug.Print "Tbale NAme: " & tdf.Name & vbTab & vbTab & _<br>    "Attributes: " & tdf.Attributes<br>    <SPAN style="color:#00007F">Next</SPAN> tdf<br>    .Close<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[DrOktagon]

Again, thanks Tom.

And trust me, I understand if you are not able to continue to answer my questions. You have helped so much already.

Here is another question though.

Since I now can create a table with the exact field names I want and correct types, is it possible to use a macro to just cut and past column by column from a designated Excel sheet into an Access table. to be specific, copy the first column in the sheet, paste to the first field in an Access table, then copy the second column and past to the second field in an Access table, and so on. I know this works by hand (and preserves all the characters), but I have too many fields and too many tables to do it all by hand.

Thanks Again

 

[Trevor G]

Please don't get my name wrong ! Who is Tom.

Try this code

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> DAOFromExcelToAccess()<br><SPAN style="color:#007F00">' exports data from the active worksheet to a table in an Access database</SPAN><br><SPAN style="color:#007F00">' this procedure must be edited before use</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> db <SPAN style="color:#00007F">As</SPAN> Database, rs <SPAN style="color:#00007F">As</SPAN> Recordset, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> db = OpenDatabase("M:\Access Files\Test ME Today.mdb")<br>    <SPAN style="color:#007F00">' open the database</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rs = db.OpenRecordset("Stuff Today", dbOpenTable)<br>    <SPAN style="color:#007F00">' get all records in a table</SPAN><br>    r = 2 <SPAN style="color:#007F00">' the start row in the worksheet</SPAN><br>    <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">While</SPAN> Len(Range("A" & r).Formula) > 0<br>    <SPAN style="color:#007F00">' repeat until first empty cell in column A</SPAN><br>        <SPAN style="color:#00007F">With</SPAN> rs<br>            .AddNew <SPAN style="color:#007F00">' create a new record</SPAN><br>            <SPAN style="color:#007F00">' add values to each field in the record</SPAN><br>            .Fields("EmployeeID") = Range("A" & r).Value<br>            .Fields("Hobbies") = Range("B" & r).Value<br>            .Fields("Vacation") = Range("C" & r).Value<br>            .Fields("AnnualBonus") = Range("D" & r).Value<br>            <SPAN style="color:#007F00">' add more fields if necessary...</SPAN><br>            .Update <SPAN style="color:#007F00">' stores the new record</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        r = r + 1 <SPAN style="color:#007F00">' next row</SPAN><br>    <SPAN style="color:#00007F">Loop</SPAN><br>    rs.Close<br>    <SPAN style="color:#00007F">Set</SPAN> rs = <SPAN style="color:#00007F">Nothing</SPAN><br>    db.Close<br>    <SPAN style="color:#00007F">Set</SPAN> db = <SPAN style="color:#00007F">Nothing</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[DrOktagon]

haha, sorry Trevor.

Tom is another person who has been helpful to me on the board. Sorry for the slip!

Thanks again for your help. I'll try this code out later today.

Devon