Importing a Spreadsheet with VBA

M

Michael Conroy

I would like to program a button that takes the user through the importing of
a spreadsheet without using the built in wizard. All they would do is point
to the file. The data is being dumped from a data hub into Excel, (can't get
it directly) and the field names are constant and I don't need a PK just yet.
I am being lazy and have done no pre-research before asking the experts so if
you want to skip over this I will understand.

1.) Is there a way to allow the user to browse to the location and select a
spreadsheet? The file is on a network drive with a different name each month.

2.) What is the best command to use to import the data once the file has
been selected? Can I use the all wildcard (*) or must I reference each field?

3.) Is this a huge deal and should I teach the user to step through the
wizard?
 
A

Allen Browne

You will need to be familiar with VBA to use these answers to your
questions.

1. Here's the API call to get the File Open dialog:
http://www.mvps.org/access/api/api0001.htm
You can filter it to XLS files.

2. TransferSpreadsheet. No need to referene the field names. Just run the
wizard manually once to create the target table. Since the field names don't
change, you can use the same table again next time.

3. In the real world, imports are non-trivial. Columns sometimes have the
wrong data in them, or there are blanks where you want to import into a
required field, or you have to match/transldate values with a lookup table,
or Access doesn't understand the date format, or ... What I generally do is
this:

Step 1: User selects a file, and we import it into a temp table (no
validation rules, all text fields.) We then run a series of tests on the
temp table, deleting entries that are blank, matching lookups, identifying
invalid entries, etc.

Step 2: All bad entries are shown in a form where the user must fix them
before the import can proceed. Once all problems are fixed, but button for
Step 3 is enabled.

Step 3: Execute the append query/queries to add the data to the real
table(s).
 
E

Ed Adamthwaite

Hi Michael,
Allen's suggestion to use the common dialog code is a good one. Your users
will be amazed, "how did you do that?!!!" they'll consider you a real code
guru.
Try the code below, it's a bit of a cludge and assumes a few prerequisites.
Watch out for line wraps with your news reader when copying the code.
'------------------------------------------------------------------------

Sub test()
CreateTableFromXL "c:\MyTestFile.xls", "tblTest", 1, "A1"
End Sub
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

Sub DeleteTable(tblName As String)
On Error GoTo ErrorHandler
DoCmd.SetWarnings False
DoCmd.DeleteObject acTable, tblName
GoTo ThatsIt
ErrorHandler:
Select Case Err.Number
Case 3211, 3011, 7874
Case Else
MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf _
& "in DeleteTable()"
End Select
ThatsIt:
DoCmd.SetWarnings True
End Sub

'------------------------------------------------------------------
 
Top