Visual Basic > Database SQL Stuff sample source codes

Visual Basic Code > How to update an Excel spreadsheet using ADO

How to update an Excel spreadsheet using ADO

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