0
\$\begingroup\$

For each ID found in Column A in the XLS file, run a query to retrieve and save a customer.

"Customers" table in db.accdb Access file
+----+-----------------+
| ID |    Customer     |
+----+-----------------+
|  1 | Thomas Moody    |
|  2 | Natalie Laguna  |
|  3 | James Robinson  |
+----+-----------------+

.xlsx Excel worksheet
+----------+
| Column A |
+----------+
|        1 |
|        2 |
|        3 |
+----------+

Solution:

  • Should I use Singleton pattern to persist connection lifetime?
  • I'm sure it's better to retrieve all customers at once but what's next? How do I retrieve customers that easily?

Option Explicit

Private pDb As ADODB.Connection
Private pDbCmd As ADODB.Command
Private pDbRecordset As ADODB.Recordset

Private Sub Main()

    ' Assuming I've already read values from column into an array
    Dim customerIDs(1 To 3, 1 To 1) As Long
    Let customerIDs(1, 1) = 1
    Let customerIDs(2, 1) = 2
    Let customerIDs(3, 1) = 3

    Dim i As Long
    Dim customerID As Long
    Dim customer As String

    ' For each ID run a query, retrieve and display a customer name
    For i = 1 To UBound(customerIDs, 1)
        Let customerID = customerIDs(i, 1)
        Let customer = GetCustomer(customerID)

        Debug.Print customer
    Next i

    Call CloseConnection

End Sub

Private Function QueryDB(sqlQuery As String) As String

    ' Singleton
    If (pDb Is Nothing) Then
        Call OpenConnection
    End If

    Call ExecuteCmd(sqlQuery)
    Let QueryDB = ReadRecord

End Function

Private Function GetCustomer(ID As Long) As String

    ' Prepare SQL query
    Dim sqlQuery As String
    Let sqlQuery = "SELECT Customer FROM Customers WHERE Customers.ID = " & ID

    ' Return
    Let GetCustomer = QueryDB(sqlQuery)

End Function

Private Sub OpenConnection()

    Set pDb = New ADODB.Connection
    Set pDbCmd = New ADODB.Command
    Set pDbRecordset = New ADODB.Recordset

    Dim dataSource As String
    Let dataSource = ThisWorkbook.Path & "\db.accdb"

    Dim connectionString As String
    Let connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dataSource & ";Persist Security Info=False;"

    Call pDb.Open(connectionString)
    Let pDbCmd.ActiveConnection = pDb

End Sub

Private Sub ExecuteCmd(sqlQuery As String)

    pDbCmd.CommandText = sqlQuery
    pDbCmd.CommandType = adCmdText

    Set pDbRecordset = pDbCmd.Execute

End Sub

Private Function ReadRecord() As String

    Do While Not (pDbRecordset.EOF)
        Let ReadRecord = pDbRecordset.Fields("Customer").value
        Call pDbRecordset.MoveNext
    Loop

End Function

Private Sub CloseConnection()

    Call pDb.Close

    Set pDbRecordset = Nothing
    Set pDbCmd = Nothing
    Set pDb = Nothing

End Sub
\$\endgroup\$
1
\$\begingroup\$

The solution above shows some very old coding practices that are no longer valid. In addition the code has some level of complexity that is not required - almost like a Rube Goldberg approach!

The use of Option Explicit is to be applauded. Same as the lack of On Error [Resume Next]!

Main

Some broad comments:

  • The use of "Main" as a function name is not required and hides what the real intent is.
  • You use a 2-D array when a single dimension will do.
  • You juggle values through different variables without any real reason.
  • Why not show the code you will use to extract the IDs from the Excel file?
  • You call CloseConnection but you have not opened one.

Refactored code below

Private Sub Main()
    ' Assuming I've already read values from column into an array
    'Dim customerIDs(1 To 3) As Long
    'customerIDs(1) = 1
    'customerIDs(2) = 2
    'customerIDs(3) = 3
    Dim customerIDs as Variant
    customerIDs = Range("NamedRangeHoldingColumnOfIDs") ' this will return an array

    Dim i As Long
    Dim customer As String

    ' For each ID run a query, retrieve and display a customer name
    OpenConnection ' should Open and Close in the same scope
    For i = 1 To UBound(customerIDs)
        If IsNum(customerIDs(i)) then  ' doesn't hurt to add a bit of error checking
            customer = GetCustomer(CLng(customerIDs(i)))
            Debug.Print customer
        End If
    Next i
    CloseConnection
End Sub

Helper functions

You have fractured your helper functions too much, you are probably confusing yourself with your logic.

  • Your ReadRecord function reads all records in the recordset, which you have set with your GetCustomer, QueryDB and ExecuteCmd routines.
  • Perhaps breaking them apart would make sense if you were to re-use them, but your calls (parameters) and returns are not set up to allow this. Your use of globals would make re-use fraught with danger (particular in overlapping or older calls, and race conditions)

Refactoring all this into one function makes it cleaner.

Private Function GetCustomer(ID As Long) As String
    Dim sqlQuery As String
    Dim readResult as String
    sqlQuery = "SELECT Customer FROM Customers WHERE Customers.ID = " & ID
    If (pDb Is Nothing) Then
        OpenConnection  ' could consider opening and closing connection only in this scope - could be expensive but safer.
    End If

    ' Return
    pDbCmd.CommandText = sqlQuery  ' Assumes pDbCmd is valid
    pDbCmd.CommandType = adCmdText
    Set pDbRecordset = pDbCmd.Execute
    Do While Not (pDbRecordset.EOF)
        readResult = pDbRecordset.Fields("Customer").value
        pDbRecordset.MoveNext
    Loop
    GetCustomer = readResult
End Function

Connections

Having done this, you rely on globals to manage your connections. All fine if you have a single purpose - but if you are going to make this more complex it will introduce problems. You can fix this by treating your Open and Close as parameterised routines.

Private Sub CloseConnection(Db as ADODB.Connection, DBRecordSet as ADODB.Recordset, DbCmd As ADODB.Command)
    Db.Close
    Set DbRecordset = Nothing
    Set DbCmd = Nothing
    Set Db = Nothing
End Sub

Similarly for OpenConnection

Private Sub OpenConnection(ByVal DbName, [ByRef] Db as ADODB.Connection, [ByRef] DbCmd As ADODB.Command ) 'As Boolean - perhaps indicate if successful?
    Set Db = New ADODB.Connection
    Set DbCmd = New ADODB.Command
    Dim dataSource As String
    dataSource = ThisWorkbook.Path & DbName '"\db.accdb"
    Dim connectionString As String
    connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dataSource & ";Persist Security Info=False;"
    Db.Open(connectionString)
    DbCmd.ActiveConnection = Db
End Sub

Additional thoughts

Having gone through the above process, the key DB element is the DBCmd object. Your Open/Close could simply pass that as a result with all other workings to get there encapsulated within the relevant function.

You don't do any error checking.

  • What happens if you cannot open the database?
  • What happens if you cannot open the query?
  • What happens if you cannot find a relevant record?
\$\endgroup\$
6
  • \$\begingroup\$ If I were to use parameterised Open and Close connection functions, how would I check in GetCustomer if DB object is nothing? Also, isn't it a problem to run a query after query in the loop? I would need my helper functions for querying if I introduced more functions like: GetAddress, GetProduct etc. \$\endgroup\$ – Ruby Harris Jun 10 '18 at 7:03
  • \$\begingroup\$ @RubyHarris that's what the error checking is for \$\endgroup\$ – Raystafarian Jun 10 '18 at 21:33
  • \$\begingroup\$ @RubyHarris: Your ReadRecord is specific to "Customers" - if you wanted to introduce more functions like GetAddress etc, you would have to refactor your code. Which is exactly what I was saying: "•Perhaps breaking them apart would make sense if you were to re-use them, but your calls (parameters) and returns are not set up to allow this. Your use of globals would make re-use fraught with danger (particular in overlapping or older calls, and race conditions)" \$\endgroup\$ – AJD Jun 10 '18 at 22:00
  • \$\begingroup\$ Missing an End If in Main \$\endgroup\$ – Ryan Wildry Jun 12 '18 at 18:48
  • \$\begingroup\$ May also want to consider using a parameterized query, or least, call out the risk of not using one. It's fine for local files...but you wouldn't want xkcd.com/327 \$\endgroup\$ – Ryan Wildry Jun 12 '18 at 20:38
0
\$\begingroup\$

Question 1

"Should I use Singleton pattern to persist connection lifetime?"

I Singleton pattern suggest that you have a Global variable used by multiple procedures. Using this pattern you will either have to have a single procedure open and close the connection or test that the connection is open at every point of use. The problem with having to test that is open is that you will also have to decide if another procedure is using the connection or just leave it open anyway. It would be far easier to create and open the connection in your Main() procedure and pass it as a parameter to any secondary methods.

Question 2

"I'm sure it's better to retrieve all customers at once but what's next? How do I retrieve customers that easily?"

This is a pretty broad statement and requires more information for a definitive answer.

How many fields and or tables do you want to retrieve? In your question you listed 1 table and 2 fields. In your comments to @AJD you introduced GetAddress and GetProduct. I am assuming that these are Products is probably a separate table and will probably only require that updating a few records at once. Where as, Address probably belongs to the Customer table and ID, Customer implies that you may be syncing hundreds, thousands, or more records at once. These are very different problems that require different approaches.

If you only need to retrieve a couple of hundred records, opening and closing the connection after each call will not have much impact to your performance. When working with large datasets, querying all the necessary records at once will greatly improve your performance.

Using Microsoft Access SQL IN() Operator and Clause to limit Selected Record

Reference: MSDN:In Operator (Microsoft Access SQL)

The Microsoft Access SQL IN() Operator will limit the dataset to include only records that have values in a field contained in a value list:

SELECT Customer FROM Customers WHERE Customers.ID IN(1,2,3)

Reference: MSDN:IN Clause (Microsoft Access SQL)

The Microsoft Access SQL IN() Clause retrieves records from an external datasource:

SELECT CustomerID, CompanyName
FROM CustomersRange
IN "c:\documents\xldata.xls" "EXCEL 5.0;"

Combining the two techniques, we can limit the records selected from the OP's database.Customers table to include only records that are in the ID field of Worksheets("Sheet1") like this:

SELECT ID, Customer FROM [Customers] WHERE [Customers].ID 
IN(
SELECT ID FROM [Sheet1$] IN '\example.xlsm'[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=YES;'] 
)

Updating Excel.Customers From Access.Customers

I do not know if it is possible to directly update Excel from an external data source using an ADO Query. What you can do is retrieve the records, copy the recordset to a temp worksheet and then run a second query to update the records on the main worksheet.

Update Excel Form Access


UpdateExcelCutomers:Sub

Here is a simplified working example of how to update an Excel table from Access. I wrote this code, in such a way, that it would be easy to follow. From here, I would recommend extracting several methods including getAccessConnection(FileName), getExcelConnection(FileName), getTempWorksheet and possibly getXLConnString(FileName,WorkSheetName) and add Error Handlers.

Public Sub UpdateExcelCutomers()
    Dim ConnectionString As String, SQL As String
    Dim FieldNames() As Variant
    Dim conn As Object, rs As Object
    Dim j As Long

    'Access Database Connection String
    ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\db.accdb" & ";Persist Security Info=False;"
    Set conn = CreateObject("ADODB.Connection")
    conn.Open ConnectionString

    FieldNames = Array("ID", "Customer", "First Name", "Last Name")

    'Retrieve Customers Fields From Access Database WHERE ID IN Excel Customers.ID
    SQL = _
        "SELECT [" & Join(FieldNames, "],[") & "] FROM [Customers] WHERE [Customers].ID IN(SELECT ID FROM [Customers$]" & vbNewLine & _
        "IN '" & ThisWorkbook.FullName & "'[Excel 12.0;Provider=Microsoft.ACE.OLEDB.12.0;Mode=Read;Extended Properties='HDR=YES;'] )"

    Set rs = conn.Execute(SQL)
    With ThisWorkbook.Worksheets.Add
        .Range("A1").Resize(1, UBound(FieldNames) + 1).Value = FieldNames
        .Range("A2").CopyFromRecordset rs
        'Close the Connection to the Access Database
        conn.Close

        'Excel Connection String
        ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=YES"";"
        conn.Open ConnectionString
        'Update Excel Cumstomer
        SQL = "UPDATE [" & .Name & "$] INNER JOIN [Customers$] ON [" & .Name & "$].ID = [Customers$].ID SET "

        For j = 1 To UBound(FieldNames)
        If j > 1 Then SQL = SQL & ","
            SQL = SQL & "[Customers$].[" & FieldNames(j) & "] = [" & .Name & "$].[" & FieldNames(j) & "]"
        Next

        conn.Execute SQL
        conn.Close
        Application.DisplayAlerts = False
        .Delete
         Application.DisplayAlerts = True
    End With

    ThisWorkbook.Worksheets("Customers").Columns.AutoFit

End Sub
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.