Importing excel with dynamic columns to Access

  • Thread starter Thread starter tig
  • Start date Start date
T

tig

I receive a daily excel file that I need to get into access. Simple
enough right?

The two problems are that the sheet will have varying columns of data
from one day to the next and column headings could be duplicated (e.g.
a1 = "address", j1 = "address" and t1 = "address" or any combination).

Unfortunately, I have no control over the creation of the excel file
and would like to leave that untouched if possible, to avoid a step
that the end user can mess up or forget.

Theoritically, I think I could use a two dimensional array to map the
cell value and it's respective column header to a temporary access
table. Although, I'm not really sure how to go about doing that.
There has to be an efficient way to handle this.

I'm open to any suggestions.

TIA
 
The biggest problem you have here is multiple columns with the same name.
You might have better success if you consider automation. It takes a lot of
code, but at least you will be able to control it.
 
What do you mean by automation? VB script? That's what I was
thinking, but am not sure what the best approach is.

Thanks for the post, Klatuu.
 
Automation mean interfacing different applications. Microsoft used to call it
Com. If you have not done it before, there is a bit of a learning curve, but
in the long run, it will be worth it.

You will need to become familiar with the Excel Object model. There are
some similarities to the Access Object model. There are also some
differences.

To use Excel, you need to use VBA. You will first have to establish an
Excel Object and the objects within Excel you plan to use. For an example
that may help you get started, look in VBA Help for the CreateObject method.
One word of caution - Always use late binding.

Start with that, and post back when (not if) you have more questions.
 
Klatuu,

Thanks for the start. I have used Com a little in that past. So I've
been able piece together a start here. The problem I have is checking
to see if a fieldname already exists in my tabledef before my
"db.TableDefs.Append tdfNew". I'll paste my code thus far. Thanks in
advance for any insights.

Sub import_file()

Dim db As Database
Set db = CurrentDb
Dim tdfNew As TableDef
Dim rst As Recordset

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Set xlBook = GetObject("excelfile.xls")
Set tdfNew = db.CreateTableDef("temptable")
Set xlApp = xlBook.Parent
Set xlSheet = xlBook.Sheets(1)

Dim fieldname$
Dim x&

'get total rows and columns used
Dim trows&
Dim tcols&
trows = xlSheet.UsedRange.rows.Count
tcols = xlSheet.UsedRange.Columns.Count


For x = 1 To tcols
With tdfNew
fieldname = xlSheet.Cells(1, x)
.Fields.Append .CreateField(fieldname, dbText)
End With
Next x

db.TableDefs.Append tdfNew

rst.Edit
rst.Update
rst.Close

xlBook.Close savechanges:=False

xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing


MsgBox "Changes completed"

End Sub
 
Looks like you have a pretty good start. Here is a function that will
determine whether a field exists in your table:

Public Function FindFieldName(strTblName As String, strFldName As String) As
Boolean
Dim tdfs As TableDefs
Dim tdf As TableDef
Dim flds As Fields
Dim fld As Field

On Error GoTo FindFieldName_Error

FindFieldName = False
Set tdfs = CurrentDb.TableDefs
Set tdf = tdfs(strTblName)
Set flds = tdf.Fields
For Each fld In flds
If fld.Name = strFldName Then
FindFieldName = True
Exit For
End If
Next fld

FindFieldName_Exit:

On Error Resume Next
Exit Function

FindFieldName_Error:

If Err.Number = 3265 Then
MsgBox "Table " & strTblName & " Not Found"
Else
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure FindFieldName of Module modUtilities"
End If
GoTo FindFieldName_Exit
End Function


Also, I would add this line of code before any other Excel object
declarations:
Set xlApp = CreateObject("excel.application")

Then
Set xlBook = xlApp.Workbooks.Open("excelfile.xls", 0, True)

I would also recommend you dim your Excel objext as objects rather than ans
explicit Excel objects. This forces what is called "late binding". This is
better because if multiple users should share the code, early binding (what
you are doing) could cause errors if their Excel versions and DLL versions
are not exactly the same as yours.
 
Thanks for the help. The function works great. I now can successfully
create my table. I'll be working on somehow mapping the cell values to
the correct fields. I have attached my code so far in case it might be
useful to someone else someday.

Thanks again,

Sub import_file()
Dim db As Database
Set db = CurrentDb
Dim tdf As TableDef
Dim rst As Recordset

Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object

On Error GoTo err_handler

Set xlApp = CreateObject("excel.application")
Set xlBook = xlApp.Workbooks.Open("o:\operations\access
applications\trade coord\TradeHubFile.xls", 0, True)
Set xlSheet = xlBook.Sheets(1)

Dim fieldname$
Dim tbl_name$
Dim dupe_field As Boolean
Dim x&
Dim field_ext1$
Dim field_ext2$

'get total rows and columns used
Dim trows&
Dim tcols&
trows = xlSheet.UsedRange.Rows.Count
tcols = xlSheet.UsedRange.Columns.Count

create_table_def:

Set tdf = db.CreateTableDef("temptable")
tbl_name = tdf.Name
fieldname = xlSheet.Cells(1, 1)
tdf.Fields.Append tdf.CreateField(fieldname, dbText)
db.TableDefs.Append tdf

For x = 2 To tcols
With tdf
fieldname = xlSheet.Cells(1, x)
dupe_field = FindFieldName(tbl_name, fieldname)
If dupe_field = True Then
Do Until dupe_field = False
field_ext1 = Mid(Right(fieldname, 2), 1, 1)
field_ext2 = Right(fieldname, 1)
If field_ext1 = "_" And IsNumeric(field_ext2) Then
fieldname = Left(fieldname, Len(fieldname) - 1) &
CStr(field_ext2 + 1)
Else
fieldname = fieldname & "_1"
End If
dupe_field = FindFieldName(tbl_name, fieldname)
Loop
End If
.Fields.Append .CreateField(fieldname, dbText)
End With
Next x

'Set rst = db.OpenRecordset(tbl_name)
'rst.Edit
'rst.Update
'rst.Close

xlBook.Close savechanges:=False

xlApp.Quit
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

'MsgBox "Changes completed"

Exit Sub

err_handler:
If Err.Number = 3010 Then
db.TableDefs.Delete (tbl_name)
Resume
Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
End If

End Sub

Public Function FindFieldName(strTblName As String, strFldName As
String) As Boolean

Dim tdfs As TableDefs
Dim tdf As TableDef
Dim flds As Fields
Dim fld As Field

On Error GoTo FindFieldName_Error

FindFieldName = False
Set tdfs = CurrentDb.TableDefs
Set tdf = tdfs(strTblName)
Set flds = tdf.Fields
For Each fld In flds
If fld.Name = strFldName Then
FindFieldName = True
Exit For
End If
Next fld

FindFieldName_Exit:

On Error Resume Next
Exit Function

FindFieldName_Error:

If Err.Number = 3265 Then
MsgBox "Table " & strTblName & " Not Found"
Else
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure FindFieldName of Module modUtilities"
End If
GoTo FindFieldName_Exit

End Function
 
OK. One more thing. I've read the posts on this issue and I thought I
was setting up and releasing excel correctly. I can't get Access to
release the excel application.

Any ideas??

TIA
 
Alright nevermind. I eliminated the xlbook.close method and Access
releases Excel everytime.
 
Back
Top