Run a query for each value in a column

Question

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

Answer 1

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?

• Ruby Harris: 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.
• Raystafarian: @RubyHarris that's what the error checking is for
• AJD: @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)"
• Ryan Wildry: Missing an End If in Main
• Ryan Wildry: 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

Answer 2

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