Import

[mienz]

I've got the following problem: I want to import a named Excel range which contains several Areas into an Access table. I tried the following code but it didn't work. I'm using Access97

Public Function ImportXLSNamedRange(strFile As String, strTable As String, strRange As String)


On Error GoTo ImportXLSNamedRange_Error

Dim XLSObject As Object
Dim wbk As Object
Dim wks As Object
Dim Rs As Recordset
Dim lgnCols As Long
Dim lgnRows As Long
Dim vRange As Variant
Dim x As Long
Dim y As Long

'Check if file to import exists
If Dir(strFile) = "" Then
MsgBox "File " & strFile & " not found!", vbExclamation
GoTo ImportXLSNamedRange_Exit
End If

Set XLSObject = CreateObject("excel.application")
Set Rs = CurrentDb.OpenRecordset(strTable)


With XLSObject
.DisplayAlerts = False
.Visible = True
.Workbooks.Open strFile

vRange = .Range(strRange)

If IsArray(vRange) Then
lgnRows = UBound(vRange, 1)
lgnCols = UBound(vRange, 2)
Else
lgnRows = 1
lgnCols = 1
End If

For x = 1 To lgnRows
Rs.AddNew
For y = 1 To lgnCols
'On Error Resume Next
If IsArray(vRange) Then
Rs(y - 1) = vRange(x, y)
Else
Rs(y - 1) = vRange
End If
'On Error GoTo 0
Next y
Rs.Update
Next x


Rs.Close
.ActiveWorkbook.Close SaveChanges:=False
.Quit

End With

ImportXLSNamedRange_Exit:
Set XLSObject = Nothing
Exit Function

ImportXLSNamedRange_Error:
MsgBox "An error occured when attempting to load:" & vbCrLf & strFile & vbCrLf & vbCrLf & _
"Number: " & Err.Number & vbCrLf & "Description: " & Err.Description, vbExclamation + vbOKOnly, "ERROR!"
Resume ImportXLSNamedRange_Exit

End Function

 

[PHV]

Have you tried the DoCmd.TransfertSpreadsheet method ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[mienz]

Unfortunately in Access97 the TransferSpreadsheet method doesn't work with named ranges