By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,686 Members | 2,708 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,686 IT Pros & Developers. It's quick & easy.

Importing Excel SpreadSheets into Access, from Access, only if not hidden.

P: n/a
I have the project that may never end in front of me.

I am creating a routine that will take SpreadSheets from Excel and
bring them into Access.

I am not using any "DoCmd"s because the goal is for the import code
to be moved to a stand alone VB app which will use the Access DB as a
workspace to process the data from the spreadsheets. Quite honestly,
done right this may not even require Access or Excel to be on the
users machine. Right now all code and testing occurs in Access.

The code I use to bring the sheets into Access looks like:

Public rsTable As ADODB.Recordset
Public strSheet As String
Public StrExceptionReason As String
Public coListOfExcelTables As New Collection

Private cnMvConnection As ADODB.Connection
Private strPath As String
Sub ImportMembers()
Dim i As Integer
Dim j As Integer

Dim cat As ADOX.Catalog
Set cat = New ADOX.Catalog

'The folowing is here for testing - replace with your Path & File.
'I use split and an array because I will need to process many Excel
files at once.
'They will be passed to the final executable "command line style."
strTableName = "X:\MBS_JOBS\71228A\71228ASHIPPER.XLS"
aryShippers = Split(strTableName, " ")

For i = 0 To (CInt(UBound(aryShippers)) -
strPath = aryShippers(i)

Connect (strPath)


For j = 1 To coListOfExcelTables.Count
'I add "xl_" to the tables name so I can separate them
from other
'tables which I have in the DB (helps during testing).
strSheet = "xl_" & coListOfExcelTables(j)


'Do LOTS of other stuff - so I can get what I need, change
what needs
'to change and store the results in a pre-existing table
in this DB.

cat.ActiveConnection = CurrentProject.Connection
For j = 1 To coListOfExcelTables.Count
' Delete the table, if it exists - to make way for the
next set
' of Sheets from the next file..
On Error Resume Next
cat.Tables.Delete "xl_" & coListOfExcelTables(j)

Set cnMvConnection = Nothing
End Sub
Private Function Connect(ByVal strFullPathToExcelSpreadsheet As
String) As Boolean
'Make and open a connection to a given Excel spreadsheet
Set cnMvConnection = New ADODB.Connection

With cnMvConnection
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" &
strFullPathToExcelSpreadsheet _
& ";Extended Properties=Excel 8.0;"
End With
End Function
Private Function GetExcelTables()
'Get a list of tables available in the Excel spreadsheet which was
opened in the "Connect" function
Dim rs As ADODB.Recordset
Dim iTableNumber As Integer: iTableNumber = -1

Set coListOfExcelTables = New Collection
Set rs = New ADODB.Recordset

'Use the ADODB.Connection.OpenSchema method to get the structure
of the Excel spreadsheet
With cnMvConnection
Set rs = .OpenSchema(adSchemaTables)
End With

With rs
Do While Not .EOF
iTableNumber = iTableNumber + 1
'The TABLE_NAME field gives the name of the Table (Sheet).

'Thanks go out to Aceto De'Fabul, Utter Access VIP for
'getting Excel Spreadsheets with multi-word names to
'As the code is here it will pull in every single Sheet as
'table, but not "PrintArea"s
If Right(.Fields("TABLE_NAME").Value, 10) <"Print_Area"
If Left(.Fields("TABLE_NAME").Value, 1) = "'" Then
'Name of Sheet is two or more words.
(Mid(.Fields("TABLE_NAME").Value, 2, _
(InStrRev(.Fields("TABLE_NAME").Value, "'") -
'Name of Sheet is one word.
(Left(.Fields("TABLE_NAME").Value, _
Len(.Fields("TABLE_NAME").Value) - 1))
End If
End If
End With
Set rs = Nothing
End Function
Private Function GetExcelData() As ADODB.Recordset
Dim strSQL As String

'I have a specific range of data I need to collect - A11:I90
strSQL = "SELECT * INTO [" & strSheet & "] " & _
"FROM [Excel 8.0;HDR=Yes;database=" & strPath & ";].[" &
Right(strSheet, Len(strSheet) - 3) & "$A11:I90];"
CurrentProject.Connection.Execute strSQL
End Function
Private Function MakeRowsUnique()
'Add an autonumber column to ENSURE Row uniqueness.
' If you don't need it just Rem the call to it above.
Set f = CurrentDb.TableDefs(strSheet).CreateField("Unique" ,
f.Attributes = f.Attributes + dbAutoIncrField
f.OrdinalPosition = 0
CurrentDb.TableDefs(strSheet).Fields.Append f
End Function
This code is FAST, by the way. I am able to import the Sheets I need
from several Workbooks in the time it would take to do one using the
old Row-by-Row method that I continue to run into during searches on
the net.

Speed is important in what I am trying to do I have a lot that I need
to do - not shown here.

So what is the problem? Simple really - I need to know how to modify
the code above so that I only import a certain Sheet only if it is not

Any suggestions?

Jul 19 '07 #1
Share this question for a faster answer!
Share on Google+

This discussion thread is closed

Replies have been disabled for this discussion.