Run Time Error 1004 when trying to create a Query Table

Sub Test()
    Dim strConnect      As String
    Dim strSQL          As String
    Dim Provider        As String
    Dim DataSource      As String
    Dim Extended        As String
    
    Provider = "Microsoft.ACE.OLEDB.12.0"
    DataSource = ThisWorkbook.FullName
    Extended = """Excel 12.0;HDR=YES;"""
    strConnect = "Provider=" & Provider & ";" & _
                 "Data Source=" & DataSource & ";" & _
                 "Extended Properties=" & Extended & ";"
    strSQL = ThisWorkbook.Names("SQLLetters").RefersToRange.Value
    
    Dim ws              As Worksheet
    Dim dest            As Range
    Dim qt              As QueryTable
    
    Set ws = Sheets("QueryLetters")
    Set dest = ws.Range("A1")
    
    Set qt = ws.ListObjects.Add(SourceType:=xlSrcQuery, Source:=strConnect, Destination:=dest).QueryTable
End Sub

strConnect and dest look correct to me. The destination worksheet is empty.

Any ideas why I get Run-time error '1004': Application-defined or object-defined error???

Hi Robert,

Thanks for your reply. Much appreciated.

I've attached an Excel 2007 test workbook which should illustrate my approach. BTW, "SQL" is a named range in the workbook which contains my desired SQL, so I can quickly change/debug it.

I think I've isolated the problem to the connection string, but 1) the same connection string works with ADO, and 2) it's pretty much copied from http://www.connectionstrings.com/ace...-0/xlsb-files/

Run the two "Test" macros in the below workbook. The ADO approach works, the QT approach does not. I'd prefer to use the QT approach as I believe the ADO approach would hit the ADO memory leak bug. https://support.microsoft.com/kb/319998

I'd *really* like to get SQL queries working in my Excel application. I need to create a dynamically updated worksheet that summarizes data from 4 other worksheets. I feel the SQL approach is much simpler than complex LOOKUPS (esp. since I know SQL more than VBA).

Thanks again...

Originally Posted by Izandol

I have not looked at the file but for a querytable that connection must begin with "OLEDB;"

Hi Izandol,

1) I've updated the workbook. Still doesn't work. See attached.
2) This documentation of the QueryTable.Add method by Microsoft does not indicate that OLEDB is required, only for ODBC. I'm not saying you're incorrect, but if not, it would be great if MS would fix their documentation.
3) MS error trapping and error messaging is ahem "less than optimal"

Here is the code:

Option Explicit

Function CreateQueryTableFromADO(strConnect As String, strSQL As String, wksName As String) As Boolean
    ' Create query table from external data source.
    ' Takes a valid ADO connection string and a
    ' valid SQL SELECT statement.
    
    Dim cnnConnect    As ADODB.Connection
    Dim rstData       As ADODB.Recordset
    Dim qtbData       As QueryTable
    Dim wksResults    As Worksheet
    Dim iCols         As Integer
    
    On Error GoTo CreateQueryTable_Err

    ' Open connection on data source.
    Set cnnConnect = New ADODB.Connection
    With cnnConnect
        .ConnectionString = strConnect
        .Open
    End With

    ' Open Recordset object on connection.
    Set rstData = New ADODB.Recordset
    With rstData
        .Source = strSQL
        .ActiveConnection = cnnConnect
        .CursorType = adOpenForwardOnly
        .LockType = adLockReadOnly
        .Open
    End With
    
    ' Select desired worksheet
    Set wksResults = ThisWorkbook.Worksheets(wksName)
    With wksResults
        .Cells.ClearContents
        .Activate
    End With

    ' Copy recordset to worksheet
    ' Create header row
    For iCols = 0 To rstData.Fields.Count - 1
        wksResults.Cells(1, iCols + 1).Value = rstData.Fields(iCols).Name
    Next
    wksResults.Range(wksResults.Cells(1, 1), _
        wksResults.Cells(1, rstData.Fields.Count)).Font.Bold = True
        
    ' Create data row(s)
    wksResults.Range("A2").CopyFromRecordset rstData
    
    CreateQueryTableFromADO = True

CreateQueryTable_End:
    On Error Resume Next
    rstData.Close
    Set rstData = Nothing
    Exit Function

CreateQueryTable_Err:
    CreateQueryTableFromADO = False
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
    Resume CreateQueryTable_End
   
End Function

Function CreateQueryTable(strConnect As String, strSQL As String, wksName As String) As Boolean
    Dim wksResults    As Worksheet
    Dim dest          As Range
    Dim qt            As QueryTable
    
    On Error GoTo CreateQueryTable_Err

    ' Select desired worksheet
    Set wksResults = ThisWorkbook.Worksheets(wksName)
    With wksResults
        .Cells.ClearContents
        .Activate
        Set dest = .Range("A1")
    End With
    
    Set qt = wksResults.ListObjects.Add(SourceType:=xlSrcQuery, Source:=strConnect, Destination:=dest).QueryTable
    
    With qt
        .Name = "Money2"
        .Refresh
    End With
    
    CreateQueryTable = True

CreateQueryTable_End:
    On Error Resume Next
    Exit Function

CreateQueryTable_Err:
    CreateQueryTable = False
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
    Resume CreateQueryTable_End
   
End Function

Sub Convert_Range2Table()
    Dim oWS As Worksheet ' Worksheet Object
    Dim oRange As Range ' Range Object - Contains Represents the List of Items that need to be made unique
    On Error GoTo Disp_Error
    ' ---------------------------------------------
    ' Coded by Shasur for www.vbadud.blogspot.com
    ' ---------------------------------------------
    Set oWS = ActiveSheet
    Set oRange = oWS.UsedRange
    oWS.ListObjects.Add(xlSrcRange, oRange, , xlYes).Name = "Money1"
    
    If Not oRange Is Nothing Then Set oRange = Nothing
    If Not oWS Is Nothing Then Set oWS = Nothing
    ' --------------------
    ' Error Handling
    ' --------------------
Disp_Error:
    If Err <> 0 Then
        MsgBox Err.Number & " - " & Err.Description, vbExclamation, "VBA Tips & Tricks Examples"
        Resume Next
    End If
End Sub

Sub Test()
    Dim strConnect    As String
    Dim strSQL        As String
    Dim Provider      As String
    Dim DataSource    As String
    Dim Extended      As String
    
    
    Provider = "Microsoft.ACE.OLEDB.12.0"
    DataSource = ThisWorkbook.FullName
    Extended = """Excel 12.0;HDR=YES;"""
    strConnect = "Provider=" & Provider & ";" & _
                 "Data Source=" & DataSource & ";" & _
                 "Extended Properties=" & Extended & ";"
    strSQL = ThisWorkbook.Names("SQL").RefersToRange.Value
    
    If CreateQueryTableFromADO(strConnect, strSQL, "Query1") Then Convert_Range2Table
End Sub

Sub Test2()
    Dim strConnect    As String
    Dim strSQL        As String
    Dim Provider      As String
    Dim DataSource    As String
    Dim Extended      As String
    
    Provider = "OLEDB;Microsoft.ACE.OLEDB.12.0"
    DataSource = ThisWorkbook.FullName
    Extended = """Excel 12.0;HDR=YES;"""
    strConnect = "Provider=" & Provider & ";" & _
                 "Data Source=" & DataSource & ";" & _
                 "Extended Properties=" & Extended & ";"
    strSQL = ThisWorkbook.Names("SQL").RefersToRange.Value
    
    If CreateQueryTable(strConnect, strSQL, "Query2") Then Convert_Range2Table
End Sub

Originally Posted by Norie

Scott

Why not store the data in an external data source like another workbook, or database?

And if I do that, does it fix the error 1004?

Originally Posted by Izandol

"OLEDB;" must precede "Provider=" not be part of provider information.

Doh! I knew this, I just didn't pay proper attention to my coding.

It's working now. Thanks for the help, very much appreciated.

Just a couple more questions:

1) Is it possible to create the QT from the user interface, i.e. Data -> Get External Data, ...? It's not a biggie; I can just have a private routine, called manually from the VBE, to create/re-create the QT. During normal operations, I just need to retrieve the existing QT object and call the Refresh method. The SQL code is static and would never change, unless the workbook structure changes.

2) Is it possible to have the QT be a source for its own SQL? For example, if the QT is on a worksheet named "Money", the SQL code contains "... LEFT JOIN [Money$] ...". I'm not sure how to get this to work initially, since the SQL would fail. Perhaps get it to work once, then edit the SQL? I'm also not sure how stable this would be.

2A) Alternatively, just create a new sheet, and have the QT output to a separate worksheet.

Re: #2 - My final QT consolidates data from 4 other worksheets, but has a couple columns that require user input. It would be a better end user experience if s/he could input that data inline with the rest of the QT output. But 2A would also be acceptable.

3) Some of the QT output would have simple formulas, like C1 - A1 (actually it's like Money[#ThisRow],[Agreed] - Money[#ThisRow][Paid] for the Outstanding balance). What's the best approach:

A) Derive the columns via the SQL, then have the QT refresh on say the Worksheet_Activate event? (The edits would be on other worksheets)

B) Or post-process the QT to add formulas? If so, I assume the best approach is the have the SQL output "blank" placeholder columns, which are then filled with formulas via post-processing. As opposed to also trying to insert new columns into the table post-processing.

Thanks!

Originally Posted by Izandol

4. I believe you are using the wrong program. if you must use Excel, the source data is better in a separate workbook.

I totally agree! But any IT professional has run into the situation where the technical architecture is dictated by a non-technical manager, or else by budget constraints. Perhaps I would benefit from a course in Negotiation and Influencing .

I'd rather do this in Access, SQL Server, or a "proper" database, but that's not an option.

Ok, so my actual query is more like this:

SELECT 
a.CaseId, 
a.Analyst, 
a.CovNo, 
a.Suffix, 
a.LastName, 
a.FirstName, 
a.Total, 
b.Applicable, 
d.Agreed,
(b.Applicable - d.Agreed) as WriteOff,
d.WriteOffReason, 
c.Paid,
coalesce(d.Agreed, b.Applicable)-d.Paid As Outstanding,
d.SettlementDate
FROM
(
(
(SELECT CaseId, Analyst, CovNo, Suffix, LastName, FirstName, SUM(BenefitPaid) AS Total FROM [Claims$] GROUP BY CaseId, Analyst, CovNo, Suffix, LastName, FirstName) AS a
LEFT JOIN
(SELECT CaseId, SUM(BenefitPaid) AS Applicable FROM [Claims$] WHERE Applicable="Y" GROUP BY CaseId) AS b
ON 
a.CaseId=b.CaseId
) 
LEFT JOIN
(SELECT CaseId, SUM(total) AS Paid FROM [Payments$] GROUP BY CaseId) AS c
ON
a.CaseId=c.CaseId
)
LEFT JOIN
(SELECT * FROM [Money$]) AS d
ON 
a.CaseId=d.CaseId

where Agreed could be Empty. If specified, it will always be less than Applicable. Outstanding = MIN(Agreed,Applicable)-Paid.

Excel is choking on the more advanced SQL. Google says Excel and Access don't support CASE WHEN (isn't CASE WHEN ANSI-standard SQL?), and to use SWITCH or IIF instead. I've tried both, neither work.

The SQL works if I remove WriteOff and Outstanding, or just SELECT * (i.e. the joins work ok).

Originally Posted by Izandol

3. B. the Listobject may have formulas added to it - they will automatically fill as the query table adjusts.

Perhaps I can get this working by adding formulas for the WriteOff and Outstanding calculations.

Googling now...