Import of Multiple Worksheets from Excel

[AngieD]

Hi,

I am trying desperately to import data from multiple worksheets in Excel.

Scenario:

There are certain fields required for the import which may not exist on the first sheet - they need to be found on other sheets. (Assume number of rows in each sheet is identical, but column headers aren't)

We know the field names and we can specify which sheet they are on, but I am unable to work out the code required to get this information in one table. Do I need to try and get this information into an array somehow?

Struggling! Any help would be much appreciated!

 

[arnelgp]

you are on the right track if you are thinking of arrays.
couple of years back i made custom subroutine to import data from excel to access table.
since some fields in the table may not exists in the worksheet or vise versa.

if you are interested heres the code:


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub subImportFromExcel(strTargetTable As String, Filepath As String, strSheetName As String)
' import excel file
'
' arnelgp
'
' starTargetTable = table to update
' Filepath = path and name of excel file+extension.
' strSheetName = name of sheet where update is coming from.
'
' example:
'
' Call subImportFromExcel(tblCustomer","C:\Data\Customer.xlsx", "Sheet1")
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim db As DAO.Database
Dim rs As DAO.recordSet
Dim fld As DAO.Field
Dim arrSourceFields() As String
Dim arrTargetFields() As String
Dim strDateItem As String
Set db = CurrentDb
Set rs = db.OpenRecordset(strTargetTable, dbOpenSnapshot)
ReDim arrSourceFields(0)
ReDim arrTargetFields(0)
' put field name to array
For Each fld In rs.Fields
If Not fld.Attributes And dbAutoIncrField Then
'If Not IsAutoNumber(fld) Then
ReDim Preserve arrTargetFields(UBound(arrTargetFields) + 1)
arrTargetFields(UBound(arrTargetFields)) = fld.Name
If fld.type = dbDate Then
strDateItem = strDateItem & UBound(arrTargetFields) & ";"
End If
End If
Next
Set rs = Nothing
Set rs = db.OpenRecordset("Select * From [Excel 12.0 Xml;IMEX=2;HDR=YES;ACCDB=YES;Database=" & _
Filepath & "].[" & strSheetName & "$" & "];")
' put field name to array
For Each fld In rs.Fields
ReDim Preserve arrSourceFields(UBound(arrSourceFields) + 1)
arrSourceFields(UBound(arrSourceFields)) = fld.Name
Next
Set rs = Nothing
' build insert query
' include only fields common to both tables
Dim strSQL1 As String
Dim strSQL2 As String
strSQL1 = "Insert Into " & strTargetTable & " ("
strSQL2 = "Select "
For i = 1 To UBound(arrTargetFields)
If InArray(arrTargetFields(i), arrSourceFields) Then
strSQL1 = strSQL1 & "[" & arrTargetFields(i) & "],"
If InStr(strDateItem, i) Then
strSQL2 = strSQL2 & "ToDate([" & arrTargetFields(i) & "]),"
Else
strSQL2 = strSQL2 & "[" & arrTargetFields(i) & "],"
End If
End If
Next
strSQL1 = Left(strSQL1, Len(strSQL1) - 1) & ") "
strSQL2 = Left(strSQL2, Len(strSQL2) - 1) & _
" From [Excel 12.0 Xml;IMEX=2;HDR=YES;ACCDB=YES;Database=" & _
Filepath & "].[" & strSheetName & "$" & "];"
strSQL1 = strSQL1 & strSQL2
db.Execute strSQL1, dbFailOnError
Set db = Nothing
End Sub

Private Function InArray(s As String, v As Variant) As Boolean
Dim i As Long
For i = LBound(v) To UBound(v)
If s = v(i) & "" Then
InArray = True
Exit For
End If
Next
End Function