Excel ADODB.recordsetand comparing data between Excel and Access table

[snowmantle]

Hi,

I am trying to find examples of how to compare the two below tables using ADO preferably.

The comparison would be:

Look at the product code in the Excel table

check to see if it exists in the Access table

If it does then check if the product description for that same record also matches the one in the Excel table (ignoring case and trimming spaces but not punctuation)

delete the row from the Excel table if both match

If it doesn't match then leave the row in the Excel table and go on to the next one.

If there is no good option my fall back is to create even more querytables in the Excel file and compare that but its getting a bit silly there must be a better way of doing my comparisons in VBA alone.

Anyone got any examples?

Excel Table

product code	product description
18800003	Product One
18801103	Product Two
18801903	Product Three

Access table

product_key     product_code     product_description
1               18800003         Product One
2               18801103         Product Two
3               18801903	 Product Three
4               15623423         Product Four

 

[SkipVought]

Hi,

I have scores of user defined database access functions like this. Use it just like any other spreadsheet function...

Function GetHrsOfOper(sResource As String, dDateIn As Date)
    Dim sConn As String, sSQL As String
    Dim rst As ADODB.Recordset, cnn As ADODB.Connection
    Dim sPath As String, sDB As String
    Dim sPrevCC As String, BCC As Boolean
    
    sPath = "\\FP\Procedures\NewAdmin"
    sDB = "APS_UNIVERSE"
    
    Set cnn = New ADODB.Connection

    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
           "Data Source=" & sPath & "\" & sDB & ".mdb;"
    
    Set rst = New ADODB.Recordset
    
    sSQL = "SELECT (1-TypeValue)*24 "

    sSQL = sSQL & "FROM Resource_calendar_data "

    sSQL = sSQL & "WHERE Resource Like '" & sResource & "%'"
    sSQL = sSQL & "  AND #" & Format(dDateIn, "mm/dd/yyyy") & "# >=FromDate"
    sSQL = sSQL & "  AND #" & Format(dDateIn, "mm/dd/yyyy") & "# <=ToDate"
        
    With rst
        .Open sSQL, cnn, adOpenStatic, adLockReadOnly, adCmdText
        On Error Resume Next
        .MoveFirst
        If Err.Number = 0 Then
            GetHrsOfOper = rst(0)
        Else
            GetHrsOfOper = 24
        End If
        
        .Close
    End With
    cnn.Close
    
    Set rst = Nothing
    Set cnn = Nothing
End Function

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[snowmantle]

Thanks Skip

Is it advisable to be creating a new recordset object every time I want to check a product exists in the Access table?

I have 16000 records in the Excel file to check through and about 30000 records in the Access table.

Should I be looping through each row of the recordset and checking it with 16000+ records each time to see if it is found in the Excel table?

Rather than create a new recordset? Which would be better?

There is also .Find for the recordset but that seems like it would also be inefficient I dunno?

 

[SkipVought]

You could use this function as an example and modify to...

Open a connection

Loop thru the rows of your excel sheet opening a recordset for each value using SQL.

Or open a recordset as a table and loop thru the rows, searching the recordset for the value.

All kinds of possibilities.

It an EXAMPLE.

Skip,
^{Don't let the Diatribe...
talk you to death!}
_{Just traded in my old subtlety...
for a NUANCE!}

 

[snowmantle]

Yea I can see those 2 options. I will test both versions and see how fast they are. Thanks

 

[Andrzejek]

You can connect to your Excel worksheet (cnnExc) and to your Access (cnnAcc) and get all info into 2 recordsets:

Dim rstExcel As ADODB.Recordset
Dim rstAccess As ADODB.Recordset
[green]'sSQL[/green]
SELECT "product code" As ExcelPC, 
"product description" As ExcelPD FROM ExcelFile

rstExcel.Open sSQL, cnnExc, adOpenStatic, adLockReadOnly, adCmdText

[green]'sSQL[/green]
SELECT product_code As AccPC, product_description As AccPD
FROM AccessTable

rstAccess.Open sSQL, cnnAcc, adOpenStatic, adLockReadOnly, adCmdText

For i = 1 to rstExcel.RecordCount
    rstAccess.Filter = " AccPC = '" & rstExcel!ExcelPC.Value & "'"
    If rstAccess.RecordCount > 0 Then
        rstAccess.Filter = " AccPC = '" & rstExcel!ExcelPC.Value & "'" _
            & " AND AccPD = '" & rstExcel!ExcelPD.Value & "'"
        If rstAccess.RecordCount > 0 Then
            [green]'Delete some info from Excel here[/green]
        End If
    End If

    rstExcel.MoveNext
Next i

rstAccess.Close
rstAccess = Nothing

rstExcel.Close
rstExcel = Nothing

Have fun.

---- Andy

 

[snowmantle]

Thanks Andy that helped.

Here is what I have so far.

A lot of it is commented out and its there just to show you what I have been messing around with, eg. use of parameters was an idea at first when trying to run a select statement with a where clause for every single row in the Excel table. I still have not written an approach for that.

Public Const WBOOKMASTER As String = "master.xls"

Sub InsertProducts()
    Dim AccessConn As ADODB.Connection
    [green]'Dim ExcelConn As ADODB.Connection[/green]
    Dim rstAccessProds As ADODB.Recordset
    [green]'Dim rstExcelProds As ADODB.Recordset[/green]
    Dim cmdCommand As ADODB.Command
    Dim AccessDB As String
    [green]'Dim ExcelDB As String[/green]
    Dim AccessSqlStr As String
    [green]'Dim ExcelSqlStr As String[/green]
    Dim r As Integer
    Dim AccessBookMark As Variant
    Dim sheetName As String
    
    sheetName = "filter_products"
    
    AccessDB = Workbooks(WBOOKMASTER).path & "\" & "master.mdb"
    [green]'ExcelDB = Workbooks(WBOOKMASTER).path & "\" & "master.xls"[/green]

    [green]' Open the MS Access connection[/green]
    [green]'using jet provider for both of these for consistency[/green]
    Set AccessConn = New ADODB.Connection
    AccessConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessDB & ";"
    
    [green]'Open the MS Excel connection[/green]
    [green]'Set ExcelConn = New ADODB.Connection[/green]
    [green]'With ExcelConn[/green]
        [green]'HDR is the header row check[/green]
        [green]'.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ExcelDB & ";HDR=Yes"""""[/green]
        [green]'.Open[/green]
    [green]'End With[/green]
    
    [green]'sql required for both[/green]
    AccessSqlStr = "SELECT [product_code], [product_name] FROM [ProductsTest]"
    [green]'ExcelSqlStr = "SELECT [product code], [product description] FROM [filter_products$]"[/green]

    [green]' Set the command text for MS Access.[/green]
    [green]'Set cmdCommand = New ADODB.Command[/green]
    [green]'Set cmdCommand.ActiveConnection = AccessConn[/green]
    [green]'With cmdCommand[/green]
    [green]'   .CommandText = AccessSqlStr[/green]
    [green]'    .CommandType = adCmdText[/green]
    [green]'    .Execute[/green]
    [green]'End With[/green]

    [green]' Open the Access recordset.[/green]
    Set rstAccess = New ADODB.Recordset
    [green]'Set rstAccess.ActiveConnection = AccessConn[/green]
    rstAccess.Open AccessSqlStr, AccessConn, adOpenStatic, adLockReadOnly

    [green]' Set the command text for MS Excel.[/green]
    [green]'Set cmdCommand.ActiveConnection = ExcelConn[/green]
    [green]'With cmdCommand[/green]
    [green]'    .CommandText = ExcelSqlStr[/green]
    [green]'    .CommandType = adCmdText[/green]
    [green]'    .Execute[/green]
    [green]'End With[/green]

    [green]' Open the Excel recordset.[/green]
    [green]'Set rstExcel = New ADODB.Recordset[/green]
    [green]'Set rstExcel.ActiveConnection = ExcelConn[/green]
    [green]'rstExcel.Open cmdCommand, adOpenStatic, adLockReadOnly[/green]
    
    Workbooks(WBOOKMASTER).Worksheets(sheetName).Activate
    
    [green]' Find the LAST real row[/green]
    lastRow = ActiveSheet.Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row

    For r = lastRow To 2 Step -1
        rstAccess.Filter = " product_code = '" & Trim(Range("A" & r).Value) & "'"
        If rstAccess.RecordCount > 0 Then
            [green]'Delete row[/green]
            Workbooks(WBOOKMASTER).Worksheets(sheetName).Rows(r).Delete
        End If
        rstAccess.Filter = adFilterNone
    Next r
    
    [green]' Close the connections and clean up.[/green]
    AccessConn.Close
    [green]'ExcelConn.Close[/green]
    Set cmdCommand = Nothing
    Set rstAccessProds = Nothing
    [green]'Set rstExcelProds = Nothing[/green]
    Set AccessConn = Nothing
    [green]'Set ExcelConn = Nothing[/green]
    
    [green]' Get parameter value and append parameter.[/green]
    [green]'prodCode = Trim(Cell.Value)[/green]
    [green]'Set prmProdCode = cmdCommand.CreateParameter("prodcode", adVarChar, adParamInput)[/green]
    [green]'cmdCommand.Parameters.Append prmByRoyalty[/green]
    [green]'cmdCommand.Value = prodCode[/green]
End Sub

It seems to work ok.

I initially tried to get it to work by connecting to the Excel workbook but the ThisWorkbook is the one I need to connect to so I got this runtime error: -2147467259 (80004005)

And then checked the below and decided not to try that approach for now:

http://support.microsoft.com/kb/319998

"When you retrieve a Microsoft ActiveX Data Objects (ADO) Recordset from an Excel worksheet that is open in Excel, a memory leak occurs in the Excel process. Repeated queries may eventually cause Excel to run out of memory and raise an error, or cause Excel to stop responding."

I have decided not to bother verifying whether the "product name" matches what is found for the code, because hopefully the codes should be correct. If I was to check the name I would need to replace some of the name such as O'Brian to O''Brian, I believe but I am unsure on what else to check for and how best to do it??

Here is a list of things that I would like to try and change with this:

1. Create a recordset or collection of the values in the Excel sheet so that any that are found in the Access table and can be deleted from there. Then the Excel collection/recordset can be used to update the Access table directly with the ones that are missing.

As you can see I have been playing around with using a command object but then I noticed this "a Command object is required when you want to persist the command text and re-execute it, or use query parameters. " and thought, I probably won't need it.

I also had a play around with bookmarking the filtered record in the recordset but that didnt seem applicable for what I was attempting.

If anyone has some feedback or an approach for adding the Excel values to a collection for updating the Access table that would be a great help.

Thanks

 

[snowmantle]

Change a bit of this, sorry.

    ' Find the LAST real row
    lastRow = Workbooks(WBOOKMASTER).Worksheets(sheetName).Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row

 

[snowmantle]

Oh and the runtime error was saying I could not connect to the Excel file because it was explicitly open by myself as Admin.

Apparently there is a way to connect to an open Excel file with a ADO connection but I dunno how?

+ it gives an issue with memory leakage apparently.

 

[snowmantle]

Sorry also noticed another error when the filter_products sheet isnt selected and changed some more code to the below:

    Set filterWS = Workbooks(WBOOKMASTER).Worksheets(sheetName)
    lastRow = filterWS.Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row

    For r = lastRow To 2 Step -1
        rstAccess.Filter = " product_code = '" & Trim(filterWS.Cells(r, 1).Value) & "'"
        If rstAccess.RecordCount > 0 Then
            'Delete row
            filterWS.Rows(r).Delete
        End If
        rstAccess.Filter = adFilterNone
    Next r

Thanks