Create Table from Spreadsheet

[Lee Hunter]

Does anyone have code to build a table from an excel spreadhseet. I have to
use a date in row 1 to create a field in all table records and cells from
other cols in subsequent rows to build the rest of the data fields. I will
be reading a number of spreadsheets in one pass, all with different dates, so
I can't just use a constant for the date or use the transfer spreadsheet
method.

If you have just a rough outline, I can take it from there, but am new to
DAO VBA and having a tough time getting it started. Have used
CreateObject("Excel.Application") and GetOpenFilename so I just needs the ADO
/ or DAO code specifics of creating a table, filling data fields and writing
records.

Thanks to all who try to help.

 

[Ed Adamthwaite]

Hello Lee,
the following code assumes the StartCell as the leftmost Field name, the
first field value is cell below StartCell
and the cell to right of last FieldName is ""(empty). The first row with no
values is the end of the table (EOF).
It could be easily modified by adding a loop after the setting of the
fieldnames to step through the column with dates to find the required date,
then carry on from there. If you need help with this, just decode my email
address and email to me directly.
Cheers,
Ed.

Sub CreateTableFromXL(PathAndFile As String, TableName As String, _
WorksheetNum As Integer, StartCell As String)
'Assumes StartCell as leftmost Field name, first value is cell below
StartCell,
'cell to right of last FieldName is "", 1st row with no values is EOF
On Error GoTo ErrorHandler
Dim db As DAO.Database
Dim sSQL As String
Dim sCREATE As String
Dim sINSERT As String
Dim sFIELDNAMES As String
Dim sVALUES As String
Dim sEOFtest As String
Dim sValue As String
Dim i As Integer
Dim iFieldCount As Integer
Dim XlApp As Excel.Application
Dim wkb As Excel.Workbook

Set XlApp = New Excel.Application
Set wkb = XlApp.Workbooks.Open(PathAndFile)
XlApp.Visible = True
DeleteTable TableName 'delete table if it exists
Application.RefreshDatabaseWindow
Set db = CurrentDb
i = 1

With wkb.Worksheets(WorksheetNum)
.Range(StartCell).Select
'build sql strings
Do Until XlApp.Selection.Value = ""
sValue = XlApp.Selection.Value
sFIELDNAMES = sFIELDNAMES & "[" & sValue & "], "
sCREATE = sCREATE & "[" & sValue & "] TEXT (255), "
XlApp.Selection.Offset(0, 1).Select
i = i + 1
Loop
'remove last comma and space
sFIELDNAMES = Left(sFIELDNAMES, Len(sFIELDNAMES) - 2)
sCREATE = Left(sCREATE, Len(sCREATE) - 2)
'create table
sSQL = "CREATE TABLE " & TableName & " (" & sCREATE & ");"
' Debug.Print sFIELDNAMES
' Debug.Print sSQL
db.Execute sSQL
Application.RefreshDatabaseWindow
' i = the number of fields
iFieldCount = i
For i = 1 To iFieldCount - 1
sEOFtest = sEOFtest & "'', "
Next
sEOFtest = Left(sEOFtest, Len(sEOFtest) - 2)
.Range(StartCell).Offset(1, 0).Select 'move to top left cell of values
Do
' Debug.Print sEOFtest
' Debug.Print sVALUES
sVALUES = ""
sINSERT = "INSERT INTO " & TableName & " (" & sFIELDNAMES & ") VALUES ("
For i = 1 To iFieldCount - 1
sVALUES = sVALUES & "'" & XlApp.Selection.Value & "', "
XlApp.Selection.Offset(0, 1).Select
Next
sVALUES = Left(sVALUES, Len(sVALUES) - 2)

sSQL = sINSERT & sVALUES & ");"
' Debug.Print sSQL
'Had to jump out here on detecting no Values because a "Do While" test
'created an extra row
If sVALUES = sEOFtest Then GoTo ThatsIt
db.Execute sSQL

XlApp.Selection.Offset(1, -iFieldCount + 1).Select 'move to start of
next row
Loop
End With
GoTo ThatsIt
ErrorHandler:
Select Case Err.Number

Case Else
MsgBox "Problem with CreateTableFromXL()" & vbCrLf _
& "Error " & Err.Number & ": " & Err.Description
End Select
ThatsIt:

wkb.Close
Set wkb = Nothing
XlApp.Quit
Set XlApp = Nothing
Set db = Nothing
End Sub

 

[John Nurick]

Hi Lee,

If the Excel sheets are consistently laid out you can probably just
build and execute a SQL query that treats the worksheet as two tables,
one with one column and one record - i.e. the date - and the other the
rows and columns that contain the remainder of the data. A Cartesian
join of these produces what you want, ready to append to a table you
have created manually.

Here's an example from my test database. The date is in cell B1 of
worksheet N1, and the rest of the data is in A2:J50, with row 2
containing field names "A" to "J".

INSERT INTO tblT
SELECT CDate(A.F1) AS TheDate, A, B, C, D, E, F, G, H, I, J
FROM
[Excel 8.0;HDR=No;database=C:\TEMP\Nathan\N1.xls;].[N1$B1:B1] AS A,
[Excel 8.0;HDR=Yes;database=C:\TEMP\Nathan\N1.xls;].[N1$A2:J999] AS B
;

If you write VBA code that assembles the SQL statement in a string
variable, you can then execute the query with something like

CurrentDB.Execute strSQL, dbFailOnError