CODEWITHSUNDEEP
vbaexceloledbadodb
ex-expat
ex-expat

Reputation: 81

Excel/ADO: Error Accessing Recordset

I can usually run the following code without issue, but it sometimes fails to find any records in the record set. The file itself is large - over 200k rows. In addition, it has some merged cells, and the column widths are not wide enough to view the data without auto-fitting (I am not sure if either of those could be a contributing factor). I'd also like to add that the times no records have been found have mostly been on a machine running Excel 2010, whereas the successful instances have been on a machine running Excel 2013.

Here is my code:

Dim oConn As New ADODB.Connection
Dim oRS As New ADODB.Recordset
Dim sPath
Dim sSQL As String
Dim fd As Office.FileDialog
Dim fr11 As String

Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "FR11".

sSQL = "select F3,F6,F8,F9,F10,F18,F22,F23,F28 from [Natural Detail $] where F18 = '0000121046' or F25 = 'Natural GL Acct Nbr'"

Set fd = Application.FileDialog(msoFileDialogFilePicker)

  With fd

      .AllowMultiSelect = False    
      .Title = "Please select the file." box.
      .Filters.Clear
      .Filters.Add "Excel", "*.xlsx"
      .Filters.Add "All Files", "*.*"


      If .Show = True Then
        fr11 = .SelectedItems(1) 

      End If
   End With

DBPath = fr11

oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & DBPath & "';" & _
                 "Extended Properties='Excel 12.0 Xml;HDR=No;IMEX=1;MaxScanRows=0';"

oRS.Open sSQL, oConn

If Not (oRS.BOF And oRS.EOF) Then
        Worksheets("FR11").Range("A1").CopyFromRecordset oRS
    Else
        MsgBox "No records found"
    End If

    oRS.Close
    oConn.Close
    Set oConn = Nothing

Is there anything you see that could be causing the above to sometimes fail, or that would improve the code in general. Any feedback is much appreciated.

Here is a sample of the data:

Company Name                                                                                                                

Company Name                                                                                                                

Company Info                                                                                                                

Accounting Date:    04/12/2016                                                                                                          

Company Code    Company Code    Type    Group   TP  RES Band    Name    Arrival Date    Departure Date  ACCTING CENTER1 ACCTING CENTER2 Center Name GL AL Tran Type Name    Acctng Tran Type Name   Natural Posting Item Name   Creation User Id    SAP Account Name    Paymnet Method  Document Number Payment Originator Name Natural Posting Amt ID  Acctng Tran Id  Natural GL Acct Nbr Natural CAC Id  PAY ID  ID  Totals
222 7887878 Master  4696941 0   4696941     random name 04/09/2016  04/23/2016  Undistributed   Undistributed   Company Info        REC         Ledger  RE  Ledger  CC  ******* random name 4696941 4696941 5857    0000121046  4   1616165 649848  
777 7768    Master  7575    0   783783      random name 12/01/2015  02/26/2016  Undistributed   Undistributed   Company Info        REC         Ledger  RE  Ledger  CC  ******* random name 4696941 4696941 8778    0000121046  5   6168161 128572150   
783783  4696941 Master  4696941 0   783783      random name 04/09/2016  04/25/2016  Undistributed   Undistributed   Company Info        REC         Ledger  RE  Ledger  CC  ******* random name 4696941 4696941 8   0000121046  7   198816313   5464    
4696941 78666   Master  4696941 0   4696941     random name 04/10/2016  04/22/2016  Undistributed   Undistributed   Company Info        REC         Ledger  RE  Ledger  CC  ******* random name 4696941 4696941 1097152750  0000121046  3   171984  5616    
78  4696941 Master  786 0   783783      random name 02/19/2016  03/04/2016  Undistributed   Undistributed   Company Info        REC         Ledger  RE  Ledger  CC  ******* random name 4696941 4696941 27217   0000121046  1   515678  115616  
66  786 Master  4696941 0   78378       random name 04/02/2016  04/06/2016  Undistributed   Undistributed   Company Info        REC         Ledger  RE  Ledger  CC  ******* random name 4696941 4696941 4177    0000121046  2   56468   117980742   
22  666///  Master  4696941 0   42753       random name 04/09/2016  04/29/2016  Undistributed   Undistributed   Company Info        REC         Ledger  RE  Ledger  CC  ******* random name 4696941 4696941 9   0000121046  32  198805200   42742   
783 86788   Master  4696941 0   4696941     random name 04/01/2016  04/17/2016  Undistributed   Undistributed   Company Info        REC         Ledger  RE  Ledger  CC  ******* random name 4696941 4696941 879 0000121046  7   254948  1561    
66676   4696941 Master  4696941 0   4696941     random name 02/29/2016  03/15/2016  Undistributed   Undistributed   Company Info        REC         Ledger  RE  Ledger  CC  ******* random name 4696941 4696941 78  0000121046  7   45618   615

Upvotes: 0

Views: 941

Answers (1)

Parfait
Parfait

Reputation: 107567

Syntactically, nothing is wrong with your VBA code. Simply your SQL query's WHERE condition does not return records and hence why it sporadically works. For your posted sample data F18 and F25 do not have such WHERE clause values in the columns as shown:

Spreadsheet Input

If you remove the WHERE condition all records are returned:

Spreadsheet Output

Possibly, worksheets may differ in arrangement of columns so F18 and F25 may point to different fields. So, consider explicitly referencing columns as well as the portion of the worksheet that contains the recordset. Be sure such columns do exist in each worksheet or query will fail. Finally, specify HDR=Yes in connection string to indicate first row contains column names:

sSQL = "select [Company1], [Group], [RES], [Band], [Name1]," _
           & " [CENTER2], [AL], [Tran], [Type2]" _
           & " from [Natural Detail$A10:BL19]" _
           & " where [CENTER2]='0000121046' or [Name2]='Natural GL Acct Nbr'"
...
oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & DBpath & "';" & _
                "Extended Properties=""Excel 12.0 Xml;HDR=Yes;"";"

You will notice above SQL statement has numbered suffixes by some column names which is due to the repeated column names in data source: (Company, Code, Type, Name, ...) which the Jet/ACE SQL Engine suffixes with a number in recordset as each field must be uniquely identified. First instance has no number and every one after with increasing suffixed numbers: Company, Company1, Company2... Also do note: with HDR=Yes, no field names will result in recordset:

Spreadsheet Output without headers

Last but not least, for best practices always error handle your code to show explicit message of runtime error and use Option Explicit in global space to ensure variables/objects are properly declared:

Option Explicit

Sub RunSQL()
On Error GoTo ErrHandle
    Dim oConn As New ADODB.Connection
    Dim oRS As New ADODB.Recordset

    ...
    oRS.Close
    oConn.Close
    Set oConn = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
    Exit Sub
End Sub

Upvotes: 1

Related Questions