VB and VBA Users Source Code: How to update an Excel spreadsheet using ADO
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
How to update an Excel spreadsheet using ADO
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Friday, August 03, 2001
Hits:
1725
Category:
Office
Article:
The following routine update the contents of an Excel Range using ADO and the JET OLEDB driver. An example can be found at the bottom of the post. Option Explicit 'Purpose : Updates the contents of an Excel Spreadsheet using ADO 'Inputs : sWorkbookPath The path of the workbook to update the range contents of. ' sRange The range name or range reference to update (eg. "A1:A20" or "MyRangeName") ' avNewValues A 2d zero based array of values to update the range with. ' [sWorkSheetName] The name of the worksheet to update. Only required in not using ' a range name for the sRange variable. 'Outputs : Returns zero on success, else returns an error number. 'Author : Andrew Baker 'Date : 1/Aug/2001 'Notes : Requires a reference to Microsoft ActiveX Data Objects 2.1 or greater. ' Uses the OLE DB Provider for Jet. Function ExcelRangeUpdate(sWorkbookPath As String, sRange As String, avNewValues As Variant, Optional sWorkSheetName As String = "") As Boolean Dim oConn As ADODB.Connection Dim oCmd As ADODB.Command Dim oRS As ADODB.Recordset Dim lThisRow As Long, lThisCol As Long, bAddedRow As Boolean On Error GoTo ErrFailed 'Open a connection to the Excel spreadsheet Set oConn = New ADODB.Connection '"HDR=Yes" means that there is a header row in the cell range (or named ranged), so the provider will NOT include the first row (of the selection) into the recordset. 'If "HDR=No", then the provider will include the first row (of the cell range or named ranged) into the recordset. oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sWorkbookPath & ";Extended Properties=""Excel 8.0;HDR=No;"";" 'Create a command object and set its ActiveConnection Set oCmd = New ADODB.Command oCmd.ActiveConnection = oConn oCmd.CommandText = "SELECT * from `" & sWorkSheetName & "$" & sRange & "`" 'Open a recordset containing the worksheet data. Set oRS = New ADODB.Recordset oRS.Open oCmd, , adOpenKeyset, adLockOptimistic 'Update the values in the recordset For lThisRow = 0 To UBound(avNewValues, 2) For lThisCol = 0 To UBound(avNewValues, 1) 'Note, you will get a type mismatch if the range 'already contains a value of a different type. eg. 'updating a numeric cell with a string value will 'give you a type mismatch. Get round this be using 'the .Delete and .Add methods to add a new blank 'row/cell oRS(lThisCol).Value = avNewValues(lThisCol, lThisRow) If bAddedRow Then oRS.Update End If Next oRS.MoveNext If oRS.EOF Then 'The query only returns rows which have existing values or have 'values after them. Must call AddNew for all other empty cells. oRS.AddNew bAddedRow = True End If Next If bAddedRow Then oRS.Update End If 'Close the connection oRS.Close oConn.Close Set oRS = Nothing Set oCmd = Nothing Set oConn = Nothing Exit Function ErrFailed: 'Failed Debug.Print "ExcelRangeUpdate Error: " & Err.Description Set oRS = Nothing Set oCmd = Nothing Set oConn = Nothing ExcelRangeUpdate = False End Function 'Demonstration routine Sub Test() Dim avValues As Variant, lThisRow As Long ReDim avValues(0 To 0, 0 To 19) For lThisRow = 0 To 19 avValues(0, lThisRow) = "Cell " & lThisRow + 1 Next 'Note you will need to save a blank workbook in "C:\" called "Test.xls" ExcelRangeUpdate "C:\test.xls", "Sheet1", "A1:A20", avValues End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
