importing fields from an Excel file with VBA

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

Mirco Wilhelm

Hi,

I can open the Excel file I want, but how can I get data from a field range,
like A14:H44 into a recordset Field1 to Field8 and write it into my
database?

I already searched for some code examples but only found this export to
Excel function.

would be great, if someone could help me rewrite it to an ImportRSFromExcel
function
_________________________________________________________________
Public Function ExportRSToExcel( _
ByVal objRS As Object, _
ByVal bolFieldNames As Boolean) _
As Boolean
On Error GoTo ExportRSToExcel_Error

'---------------------------------------------------------------------------
----------------
' Export an Access Recordset to a new Excel Workbook
'---------------------------------------------------------------------------
----------------

Dim objExcel As Excel.Application
Dim objExcelSheet As Excel.Worksheet
Dim intExcelCalcMode As Integer
Dim i As Integer

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

' make visible and block userinput
objExcel.Visible = True
objExcel.Interactive = False

' create new worksheet
objExcel.Workbooks.Add

' save old calcMode and set it temporary to manual
intexcelcalmode = objExcel.Calculation
objExcel.Calculation = xlCalculationManual

' set reference tonew worksheet
Set objExcelSheet = objExcel.ActiveWorkbook.Sheets(1)

' if fieldnames are set write them to the first line
If bolFieldNames = True Then

For i = 0 To objRS.Fields.Count - 1
objExcelSheet.Cells(1, i + 1).value = objRS.Fields(i).Name
Next i

' bold formatting
objExcelSheet.Range(objExcelSheet.Cells(1, 1),
objExcelSheet.Cells(1, i)).Font.Bold = True

' disable display refresh
objExcel.ScreenUpdating = False

' read recordset
objExcelSheet.Range("A2").CopyFromRecordset objRS

Else

' disable display refresh
objExcel.ScreenUpdating = False

' read recordset
objExcelSheet.Range("A1").CopyFromRecordset objRS

End If

' activate display refresh
objExcel.ScreenUpdating = True

' restore calculation mode
objExcel.Calculation = intExcelCalcMode

' activate user input
objExcel.Interactive = True

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

ExportRSToExcel = True

ExportRSToExcel_Error:

End Function
_________________________________________________________________
 
Based on the code you have and assuming that the range will never change,
you can try the following (I haven't tried it):
- Create variables to hold the values of the cells so you can add them later
to your fields.
Dim lngField1 as Long
etc.
- Set the variable equal the the value of the cell:
lngField1 = objExcelSheet.Range("A14")
etc.
Instead of using variables you can set the value of the cell directly to
your field. Also, I believe that using an array will be a lot better
(specially if you have lots of data), however, my knowledge on using arrays
is limited.
 
I thought of giving the function a range of fields like

...( ByVal strStartField as String, ByVal strEndField as String, ...) as
Variant

getting the data and putting it into a recordset which would be returned by
the function. This way I could reuse it to collect data from difernet fields
in various Excel files.


Jesse Aviles said:
Based on the code you have and assuming that the range will never change,
you can try the following (I haven't tried it):
- Create variables to hold the values of the cells so you can add them later
to your fields.
Dim lngField1 as Long
etc.
- Set the variable equal the the value of the cell:
lngField1 = objExcelSheet.Range("A14")
etc.
Instead of using variables you can set the value of the cell directly to
your field. Also, I believe that using an array will be a lot better
(specially if you have lots of data), however, my knowledge on using arrays
is limited.

--
Jesse Avilés
(e-mail address removed)
http://home.coqui.net/monk
Reply Only To The Newsgroup
Click to expand...
[...]
 
If managed to patch this function together... but i don't know if it works
yet. Didn't find out how to call an ADODB.Recordeset function, or if it was
possible.

My test sub keeps telling me "Object variable or With block variable not
set"
_________________________________________________________
Sub testGetRSFromExcel()

Dim srcExcelRecordSet As ADODB.Recordset

srcExcelRecordSet.Open GetRSFromExcel("test.xls", "A1", "A10", 1)

Debug.Print test
End Sub
_________________________________________________________
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)
'---------------------------------------------------------------------------
-----

Dim objExcel As Excel.Application
Dim objExcelSheet As Excel.Worksheet
Dim objStream As ADODB.Stream
Dim i As Integer

' open excel file
Set objExcel = Excel.Workbooks(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 = objExcel.ActiveWorkbook.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

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

GetRSFromExcel_Error:

End Function
 
ok,

found some help and modified my test sub to
_______________________________________________________________
Sub testGetRSFromExcel()

Dim srcExcelRecordSet As New ADODB.Recordset
Set srcExcelRecordSet = GetRSFromExcel("test.xls", "A1", "A10", 1)

End Sub
_______________________________________________________________

This seems to work but now I have to find a way to read the data from the
recordset for validation and requerying before I can write it to the
destination table.

Does anyone have an idea how i can do this, without knowing the size or
names of the fields inside the recordset?
 
Mirco Wilhelm said:
Hi,

I can open the Excel file I want, but how can I get data from a field range,
like A14:H44 into a recordset Field1 to Field8 and write it into my
database?

I already searched for some code examples but only found this export to
Excel function.

would be great, if someone could help me rewrite it to an ImportRSFromExcel
function
_________________________________________________________________
Public Function ExportRSToExcel( _
ByVal objRS As Object, _
ByVal bolFieldNames As Boolean) _
As Boolean
On Error GoTo ExportRSToExcel_Error

'---------------------------------------------------------------------------
----------------
' Export an Access Recordset to a new Excel Workbook
'---------------------------------------------------------------------------
----------------

Dim objExcel As Excel.Application
Dim objExcelSheet As Excel.Worksheet
Dim intExcelCalcMode As Integer
Dim i As Integer

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

' make visible and block userinput
objExcel.Visible = True
objExcel.Interactive = False

' create new worksheet
objExcel.Workbooks.Add

' save old calcMode and set it temporary to manual
intexcelcalmode = objExcel.Calculation
objExcel.Calculation = xlCalculationManual

' set reference tonew worksheet
Set objExcelSheet = objExcel.ActiveWorkbook.Sheets(1)

' if fieldnames are set write them to the first line
If bolFieldNames = True Then

For i = 0 To objRS.Fields.Count - 1
objExcelSheet.Cells(1, i + 1).value = objRS.Fields(i).Name
Next i

' bold formatting
objExcelSheet.Range(objExcelSheet.Cells(1, 1),
objExcelSheet.Cells(1, i)).Font.Bold = True

' disable display refresh
objExcel.ScreenUpdating = False

' read recordset
objExcelSheet.Range("A2").CopyFromRecordset objRS

Else

' disable display refresh
objExcel.ScreenUpdating = False

' read recordset
objExcelSheet.Range("A1").CopyFromRecordset objRS

End If

' activate display refresh
objExcel.ScreenUpdating = True

' restore calculation mode
objExcel.Calculation = intExcelCalcMode

' activate user input
objExcel.Interactive = True

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

ExportRSToExcel = True

ExportRSToExcel_Error:

End Function
_________________________________________________________________
21`21
Click to expand...
 
Back
Top