Importing multiple excel docs

  • Thread starter Thread starter Bob Dillen
  • Start date Start date
B

Bob Dillen

Hello,

I've got about 200 Excel documents (all of the same
layout) and I want to import them into Access. I don't
want to do this manual. Is there a solution to do this?
I'm not a very good programmer in Access.

Thanks,

Bob
 
I've been writing on a function to import given fields from a specified
excelfile/sheet but it's not fully working at the moment

I debugged the script down to this line so far
objExcelSheet.Range(strFirstFieldID, strLastFieldID).Copy
GetRSFromExcel

In the excample it would be called like this
objExcelSheet.Range("A1", "A10").Copy GetRSFromExcel
but it doesn't work. VBA help tells me the syntax is .Range(Cell1, [Cell2])
but not, what kind of variable i need to fill in.

Here's the whole thing, please post if anyone has spotted the error!

Public Function GetRSFromExcel( _
ByVal strExcelFile As String, _
ByVal strFirstFieldID As String, _
ByVal strLastFieldID As String, _
ByVal intExcelWorksheet As Integer) _
As ADODB.Recordset

'On Error GoTo GetRSFromExcel_Error

'---------------------------------------------------------------------------
--------------
' Import an Excel Workbook into an Access Recordset
'
' example call: srcExcelRecordSet = GetRSFromExcel("test.xls","A1","A10",1)
' ^ ^ ^ ^ ^
' | | | | |
' returned recordset Filename, start, end,
sheetnumber
'---------------------------------------------------------------------------
--------------

Dim objExcel As New excel.Application
Dim objExcelWorkbook As excel.workbook
Dim objExcelSheet As excel.Worksheet
Dim objStream As ADODB.Stream
Dim i As Integer

' open excel file
Set objExcelWorkbook = objExcel.Workbooks.Open(strExcelFile)

Set objStream = New ADODB.Stream
objStream.Type = adTypeText

' make invisible and block userinput
objExcel.Visible = False
objExcel.Interactive = False

' set reference to a worksheet
Set objExcelSheet = objExcelWorkbook.Sheets(intExcelWorksheet)

' disable display refresh
objExcel.ScreenUpdating = False

' read recordset
objExcelSheet.Range(strFirstFieldID, strLastFieldID).Copy GetRSFromExcel

' activate display refresh
objExcel.ScreenUpdating = True

' activate user input
objExcel.Interactive = True

objExcelWorkbook.Close
objExcel.Quit

' destroy object references
Set objExcelSheet = Nothing
Set objExcel = Nothing

Exit Function

GetRSFromExcel_Error:
Debug.Print "ERROR IN FUNCTION!"
Debug.Print "Filename: " & strExcelFile & vbCrLf & _
"Worksheet: " & intExcelWorksheet & vbCrLf & _
"Datarange: " & strFirstFieldID & ":" & strLastFieldID

End Function
 
Back
Top