converting Excel.Worksheet.Range in to ADODB.Recordset

  • Thread starter Thread starter Mirco Wilhelm
  • Start date Start date
M

Mirco Wilhelm

Hi all,

I'm trying to import an Excel Worksheet Range into an Access Recordset, but
i can't figure out how to handle this type of data.

This copies the values to the clipboard

strExcelRange = "A1:A10"
objExcelSheet.Range(strExcelRange).Copy

and when i paste it to notepad i get this output:

1 a A
2 b B
3 c C
4 d D
5 e E
6 f F
7 g G
8 h H
9 i I
10 j J

All i need to do now is to get these values into a ADODB.Recordset, but i
have to give this output to another data type first, which i haven't figured
out yet.

objExcelSheet.Range(strExcelRange).Copy NewVariable

I tried a String Array, ADODB.Recordset and even a Excel.Range, but
everytime i got the message "Invalid procedure call or argument".

Any Ideas how to do this right?
 
Hi Mirco,

Excel's Range.Copy can only copy to another Excel range or the
clipboard. Instead, do something like this:

Dim raR as Excel.Range
Dim rsT as ADODB.Recordset
Set raR = objExcelSheet.Range("A1:C10")
Set rsT = blah blah blah

For Each R in raR.Rows
rsT.AddNew
For j = 1 to R.Cells.Count
rsT.Fields(j).Value = R.Cells(j).Value
Next
rsT.Update
Next

Alternatively, import or link the Excel range to an Access table and
open a recordset on that.
 
Excel's Range.Copy can only copy to another Excel range or the
clipboard. Instead, do something like this:

Dim raR as Excel.Range
Dim rsT as ADODB.Recordset
Set raR = objExcelSheet.Range("A1:C10")
Set rsT = blah blah blah

For Each R in raR.Rows
rsT.AddNew
For j = 1 to R.Cells.Count
rsT.Fields(j).Value = R.Cells(j).Value
Next
rsT.Update
Next

Alternatively, import or link the Excel range to an Access table and
open a recordset on that.
Click to expand...

Ok, tried that, but couldn't figure out what Type R and J are of. Second
thing is how to store the data in a Recordset without writign it to the
table with .addNew, since i want to return the whole set to the caller.

Public Function GetRSFromExcel( _
ByVal strExcelFile As String, _
ByVal strFirstFieldID As String, _
ByVal strLastFieldID As String, _
ByVal intExcelWorksheet As Integer) _
As dao.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 objExcelRange As Excel.Range

Dim i As Integer
Dim strExcelRange As String, strSelectRange As String

' open excel file
Set objExcelWorkbook = objExcel.Workbooks.Open(strExcelFile)
Debug.Print "öffnen von: " & strExcelFile

' make invisible and block userinput
objExcel.Visible = False
objExcel.Interactive = False
Debug.Print "ausblenden von Excel"

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

' disable display refresh
objExcel.ScreenUpdating = False

' read recordset
strExcelRange = strFirstFieldID & ":" & strLastFieldID
Set objExcelRange = objExcelSheet.Range(strExcelRange)

For Each R In objExcelRange.Rows
GetRSFromExcel.AddNew

For J = 1 To J.Cells.Count
GetRSFromExcel.Fields(i).Value = R.Cells(i).Value
Next

GetRSFromExcel.Update
Next

' 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:

End Function
 
Ok, tried that, but couldn't figure out what Type R and J are of. Second
thing is how to store the data in a Recordset without writign it to the
table with .addNew, since i want to return the whole set to the caller.
Click to expand...

R is an Excel.Range, j is a Long.

The second thing I can't help you with as I seldom use ADO. Perhaps it's
possible to do it by using an ODBC connection to the Excel workbook.
 
The amended code (below) fabricates a disconnection ADODB recordset.
The AddNew method add a new row to the recordset, not a table. I have
hard coded to find three multi-space delimited values (integer,
string, string) in a single Excel cell.

Sub test()

Dim rsTest As ADODB.Recordset

Set rsTest = GetRSFromExcel("C:\Tempo\test.xls", "A1", "A10", 1)

Set rsTest = Nothing

End Sub

Public Function GetRSFromExcel(ByVal ExcelFile As String, _
ByVal FirstFieldID As String, _
ByVal LastFieldID As String, _
ByVal ExcelWorksheet As Long) _
As ADODB.Recordset

On Error GoTo GetRSFromExcel_Error

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

Dim objExcel As Excel.Application
Dim objExcelWorkbook As Excel.Workbook
Dim objExcelSheet As Excel.Worksheet
Dim objExcelRange As Excel.Range
Dim objExcelTempRange As Excel.Range
Dim strExcelRange As String

Dim objRS As ADODB.Recordset

' create new excel application
Set objExcel = New Excel.Application

' open excel file
Set objExcelWorkbook = objExcel.Workbooks.Open(ExcelFile)
Debug.Print "öffnen von: " & ExcelFile

' make invisible and block userinput
objExcel.Visible = False
objExcel.Interactive = False
Debug.Print "ausblenden von Excel"

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

' disable display refresh
objExcel.ScreenUpdating = False

' read recordset
strExcelRange = FirstFieldID & ":" & LastFieldID
Set objExcelRange = objExcelSheet.Range(strExcelRange)

' create new recordset
Set objRS = New ADODB.Recordset

With objRS

.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockBatchOptimistic

.Fields.Append "Col1", adInteger
.Fields.Append "Col2", adVarChar, 1
.Fields.Append "Col3", adVarChar, 1

.Open

End With

For Each objExcelTempRange In objExcelRange.Cells

AddToRS objExcelTempRange.Value, objRS

Next

' 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

Set GetRSFromExcel = objRS

Exit Function

GetRSFromExcel_Error:

End Function

Private Function AddToRS(ByVal CellContents As String, _
ByVal RS As ADODB.Recordset) As Boolean

Dim vntArray As Variant

vntArray = Split(Excel.WorksheetFunction.Trim(CellContents), " ")

With RS
.AddNew
.Fields(0).Value = vntArray(0)
.Fields(1).Value = vntArray(1)
.Fields(2).Value = vntArray(2)
End With

AddToRS = True

End Function
 
Back
Top