Beyond Excel: VBA and Database Manipulation

May 18 2010   4:11PM GMT

Building a Library of Routines for Updating – #6

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

Your are here (Click to enlarge)

Your are here (Click to enlarge)

This post’s routine, Update_Entries, cycles through all the records in an Excel range and updates any pending entries using the Update_Entry function from last post.

You may wonder why I have a single record update routine (SRUR) and a multiple record update routine (MRUR).  Why not just write a larger routine that does both?  The answer is that by having an SRUR, I can test that specific functionality very easily and I have what amounts to an entry point into the MRUR when I want to update just one record.  Since the MRUR leverages the SRUR, none of the SRUR code is duplicated in the MRUR except error handling.  However, having the routines split does cause one problem – mutliple database opens and closes.

Multliple database opens and closes slows things down dramatically.  In order to maintain speed, the SRUR accepts a connection object as well as a connection string.  If the connection object is provided, the SRUR leverages that and avoids creating its own connection to the database.  So to support that goal, we have a routine that creates a connection object that can be passed between functions – SQLConnection.

Here is the code:

Function SQLConnection(cn As ADODB.Connection, _
                       sConnect As String) As Boolean
'   Description:Create a connection to the database
'               By externalizing this, a connection can be created and reused
'   Parameters: cn - an ADODB connection object
'               sConnect - a connection string
'   Example:    bResult =  SQLConnection( _
                           cn, _
                           "Driver={Microsoft Access Driver (*.mdb)};" & _
                           "DBQ=c:\Northwind.mdb")
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    On Error GoTo ErrHandler
    SQLConnection = Failure    'Assume Something went wrong
   
    If cn Is Nothing Then
        Set cn = New ADODB.Connection
        cn.Properties("Prompt") = adPromptComplete
        cn.Open sConnect, "", ""
    End If
   
    SQLConnection = Success
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "SQLConnection - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function
Public Function Update_Entries(sConnect As String, sWorksheet As String, _
                               sHeaderRange As String, sDetailRange As String, _
                               sHeaderFields As String, sDetailFields As String, _
                               sTable As String, bRows As Boolean) As Boolean
'   Description:Update a ALL entries (entires MUST be verfied first)
'   Parameters: sConnect       ODBC Connection String
'               sWorksheet     Worksheet containing data
'               sHeaderRange   Range holding values common to all records (Opt.)
'               sDetailRange   Range holding unique rows of data
'               sHeaderFields  Range holding common field descriptions (Opt.)
'               sDetailFields  Range holding unique row field descriptions
'               sTable         Table to be updated (there can be only one)
'               bRows          "True" if entries in rows, "False" if in columns
'   Example:    bResult = Update_Entries(sConnectionString, _
                                         sDataWorkSheet, _
                                         sHeaderData, _
                                         sDetailData, _
                                         sHeaderFieldDefinitions, _
                                         sDetailFieldDefinitions, _
                                         sUpdateTable, _
                                         True)
'     Date   Init Modification
'   01/12/06 CWH  Initial Programming
    On Error GoTo ErrHandler
    Update_Entries = Success    'Assume the Best 
    
    Settings "Save"             'Save current application settings
    Settings "Disable"          'Disable events, calcs, screen updates
   
    Dim lRow As Long            'Current Row
    Dim lRows As Long           'Number of Rows in sDetailRange
    Dim iACD As Integer         'Column holding ACD (Add,Change,Delete) instr.
    Dim iErrMsg As Integer      'Column to report Error Messages
    Dim bResult As Boolean      'Generic Result variable (Success or Failure)
    Dim cn As ADODB.Connection  'ADO Connection Object (Optional-use this when
                                'updating several records to avoid unnecessary
                                'DB opens and closes)
       
    'Establish connection to the database or fail this routine
    bResult = SQLConnection(cn, sConnect)
    Update_Entries = bResult
    If bResult = Failure Then Exit Function
  
    iACD = FieldColumn("ACD", sDetailRange)         'Must have "ACD" column
    iErrMsg = FieldColumn("ERRORS", sDetailRange)   'and an "ERRORS" column
    lRows = Range(sDetailRange).Rows.Count          'Number of data rows
    With frmProgress                                'Show Progress Bar
        .pPct = 0
        .pCaption = "Updating Entries"
        .Show False
    End With
                       
    Debug.Print "Start: "; Now()                'Start timer(for pgmr feedback)
    With Range(sDetailRange)                    'Go through all records
        lRow = 2                                'Skip column headings
        While lRow <= .Row + .Rows.Count        'Update the database
            If .Cells(lRow, iACD) > "" And _
                InStr(1, "ACD", .Cells(lRow, iACD)) > 0 Then
                bResult = Update_Entry(sConnect, sWorksheet, _
                                       sHeaderRange, sDetailRange, _
                                       sHeaderFields, sDetailFields, _
                                       sTable, lRow, iACD, iErrMsg, cn)
                If bResult = Failure Then Update_Entries = Failure
            End If
            lRow = lRow + 1
            frmProgress.pPct = lRow / lRows
        Wend
       
        lRow = 2                                'Remove deteled rows
        While lRow <= .Row + .Rows.Count
            If .Cells(lRow, iACD) = "D" And _
               .Cells(lRow, iErrMsg) = "Updated!" Then
                Rows(.Cells(lRow, 1).Row).Delete Shift:=xlUp
            Else
                lRow = lRow + 1
            End If
        Wend
    End With
    Debug.Print "End: "; Now()                  'Stop the update timer
               
    cn.Close                                    'Close connection
    frmProgress.Hide                            'Close Progress Bar
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Update_Entries - Error#" & Err.Number & vbCrLf & _
        Err.Description, vbCritical, "Error", Err.HelpFile, Err.HelpContext
    Settings "Restore"                  'Restore application settings
    On Error GoTo 0
End Function
 

 Comment on this Post

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when other members comment.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to: