Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Has anyone got ADO to Excel to work??

Status
Not open for further replies.

WilliamMathias

Programmer
Sep 8, 2001
34
GB
Hi,

I'm using an ADO link to excel and I can read from the Excel file OK, but has anyone successfully written to an Excel file using ADO?

(I've previously used Automation but I've had problems with leaving instances of Excel running, despite explicitly closing them down!)


Cheers Will
 
Here is a module that I use to write to Excel from VB using ADO. I take it you know how to open the Excel work book and link it using ADO so the below module show just how I write to the worksheet. If you need more of a sample let me know.

rs.Filter = "(Item_No = '" & tempExcelPart & "')"
If rs.EOF <> True Then
If rs.Fields(&quot;Item_No&quot;) = UCase(tempExcelPart) Then
rngFeatureList.Cells(i, 4) = rs.Fields(&quot;Std_Cost&quot;)
rngFeatureList.Cells(i, 8) = rs.Fields(&quot;Qty_On_Hand&quot;)
rngFeatureList.Cells(i, 9) = rs.Fields(&quot;Qty_Allocated&quot;)
End If
End If
i = i + 1
Loop

appExcel.SaveWorkspace

chadt@techtnologies.com
 
Hi chad,

Could you post your piece of code that
opens the recordset and sets up the connection

thanks for your help Will
 
Goto to MS download center

Under product name select &quot;Visual Basic 6.0 Enterprise Edition&quot;

Under &quot;Show Results For&quot; select &quot;All Downloads&quot;

Click on &quot;Sort BY Date&quot;

Click &quot;Find It&quot;

under &quot;27 Dec 2000&quot; you will find a sample for reading/writing data to Excel under ADO
 
William

This is not my code but here goes

Option Explicit
Option Base 0

'The subroutines in this file utilize ADO for database access - you must
'have ADO 1.5 configured on your machine for them to operate properly.

Public Type DistributorData
dDistributor As String
dDistributorID As Long
dContactName As String
dAddress As String
dCity As String
dCountry As String
dRegion As String
dPostalCode As String
dPhone As String
End Type


'Proc14 below provides an example of using the GetRows method
'of the Recordset object to obtain a result array from a ADO recordset.
'The result array is then place on the worksheet - but the array is
'first transposed using the Transpose method of the Application object
'Be careful in using the Transpose method, as if your array gets too big,
'the method will fail.

Sub Proc14_CopyToRange_ADO()
Dim Rs1 As ADODB.Recordset
Set Rs1 = New ADODB.Recordset
Rs1.Open Source:=&quot;Distributors&quot;, _
ActiveConnection:=&quot;DBQ=&quot; & ThisWorkbook.Path & &quot;\SAMPDATA.MDB;&quot; & _
&quot;Driver={Microsoft Access Driver (*.mdb)};&quot;, _
CursorType:=adOpenStatic, _
LockType:=adLockOptimistic, _
Options:=adCmdTable
With Worksheets(&quot;ADOSheet&quot;)
.Range(&quot;A1&quot;).CurrentRegion.Clear
Application.Intersect(.Range(.Rows(1), .Rows(Rs1.RecordCount)), .Range(.Columns(1), .Columns(Rs1.Fields.Count))).Value = Application.Transpose(Rs1.GetRows(Rs1.RecordCount))
End With
Rs1.Close
End Sub

'Proc15 below is similar in nature to Proc14 above, however, in this
'case the result array which is returned by the GetRows method of the
'recordset object is too big for us to use the Transpose method. So
'in the case, we employ a custom VBA function (see below) called TransposeArray
'which does nothing other than transpose the array.

Sub Proc15_CopyToRange2_ADO()
Dim Rs1 As ADODB.Recordset
Set Rs1 = New ADODB.Recordset
Rs1.Open Source:=&quot;Query1&quot;, _
ActiveConnection:=&quot;DBQ=&quot; & ThisWorkbook.Path & &quot;\SAMPDATA.MDB;&quot; & _
&quot;Driver={Microsoft Access Driver (*.mdb)};&quot;, _
CursorType:=adOpenStatic, _
LockType:=adLockOptimistic, _
Options:=adCmdTable
With Worksheets(&quot;ADOSheet&quot;)
.Range(&quot;A1&quot;).CurrentRegion.Clear
Application.Intersect(.Range(.Rows(1), .Rows(Rs1.RecordCount)), .Range(.Columns(1), .Columns(Rs1.Fields.Count))).Value = TransposeArray(Rs1.GetRows(Rs1.RecordCount))
End With
Rs1.Close
End Sub

Function TransposeArray(ByRef Array1 As Variant) As Variant
Dim x As Integer
Dim y As Integer
Dim q As Integer
Dim r As Integer
Dim Array2() As Variant
x = UBound(Array1, 1)
y = UBound(Array1, 2)
ReDim Array2(y, x)
For q = 0 To x
For r = 0 To y
Array2(r, q) = Array1(q, r)
Next
Next
TransposeArray = Array2
End Function


'Proc16 provides an example of writing Excel worksheet data to an
'Access database via ADO. The process involves first opening a
'recordset, then calling the AddNew method. You then set the values of
'the various fields, and lastly call Update.

Sub Proc16_WritingWorksheetData_ADO()

Dim Range1 As Range
Dim Array1 As Variant
Dim x As Variant
Dim Rs1 As ADODB.Recordset
Set Rs1 = New ADODB.Recordset

Rs1.Open Source:=&quot;Distributors&quot;, _
ActiveConnection:=&quot;DBQ=&quot; & ThisWorkbook.Path & &quot;\SAMPDATA.MDB;&quot; & _
&quot;Driver={Microsoft Access Driver (*.mdb)};&quot;, _
CursorType:=adOpenStatic, _
LockType:=adLockOptimistic, _
Options:=adCmdTable

Set Range1 = ThisWorkbook.Worksheets(&quot;Distributors&quot;).Range(&quot;A1&quot;).CurrentRegion.Offset(1, 0)
Set Range1 = Range1.Resize(Range1.Rows.Count - 1, Range1.Columns.Count)
Worksheets(&quot;Distributors&quot;).Select
Range1.Select

'Read the worksheet range into an array.
Array1 = Range1.Value

'Then write the data from the array to the recordset.
'Note that for each new record, you must first call Addnew
'then set the value property of the fields, and then call Update.
For x = 1 To UBound(Array1, 1)
With Rs1
.AddNew
.Fields(&quot;DistributorID&quot;) = Array1(x, 1)
.Fields(&quot;Distributor&quot;) = Array1(x, 2)
.Fields(&quot;ContactName&quot;) = Array1(x, 3)
.Fields(&quot;Address&quot;) = Array1(x, 4)
.Fields(&quot;City&quot;) = Array1(x, 5)
.Fields(&quot;Country&quot;) = Array1(x, 6)
.Fields(&quot;Region&quot;) = Array1(x, 7)
.Fields(&quot;PostalCode&quot;) = Array1(x, 8)
.Fields(&quot;Phone&quot;) = Array1(x, 9)
.Update
End With
Next

Rs1.Close
End Sub


Regards



Jason
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top