Excel 2016 - ADODB recordset append to table1 1

[Xscatolare]

OK, i have Googled high and hard for a couple days to figure this out and just have to post because I find something close but not complete.

Here setting up the sql string. constring is a public varibable.

Sub ReplenQueue()

Dim strSql As String
Dim target As Range

Set target = Worksheets("Imports").Range("tblimport")


strSql = "SELECT 'REG REPLEN WIP', Count(dbo.movewkahdr.num_move)" & _
    " FROM dbo.movewkahdr INNER JOIN dbo.movewqdtl ON dbo.movewkahdr.repl_wrk_asgn = dbo.movewqdtl.repl_wrk_asgn" & _
    " WHERE (((dbo.movewkahdr.wrk_fnc_code) In (60,62,63,64,66,67,82,83)));"

Call ImportSQLtoRange(constring, strSql, target)

End Sub

Here is the ImportSQLRange. It basically opens connection and then will insert into a specific cell.

Function ImportSQLtoRange(ByVal constring As String, ByVal query As String, target As Range) As Integer

    On Error Resume Next

    ' Object type and CreateObject function are used instead of ADODB.Connection,
    ' ADODB.Command for late binding without reference to
    ' Microsoft ActiveX Data Objects 2.x Library


    ' Dim con As ADODB.Connection
    Dim con As Object
    Set con = CreateObject("ADODB.Connection")

    con.ConnectionString = constring

    ' Dim cmd As ADODB.Command
    Dim cmd As Object
    Set cmd = CreateObject("ADODB.Command")

    cmd.CommandText = query
    cmd.CommandType = 1         ' adCmdText

    ' The Open method doesn't actually establish a connection to the server
    ' until a Recordset is opened on the Connection object
    con.Open
    cmd.ActiveConnection = con

    ' Dim rst As ADODB.Recordset
    Dim rst As Object
    Set rst = cmd.Execute

    If rst Is Nothing Then
        con.Close
        Set con = Nothing

        ImportSQLtoRange = 1
        Exit Function
    End If

    Dim ws As Worksheet
    Dim col As Integer

    Set ws = target.Worksheet

    ' Column Names
    For col = 0 To rst.Fields.Count - 1
        ws.Cells(target.Row, target.Column + col).value = rst.Fields(col).Name
    Next
    ws.Range(ws.Cells(target.Row, target.Column), _
        ws.Cells(target.Row, target.Column + rst.Fields.Count)).Font.Bold = True

    ' Data from Recordset
    ws.Cells(target.Row + 1, target.Column).CopyFromRecordset rst

    rst.Close
    con.Close

    Set rst = Nothing
    Set cmd = Nothing
    Set con = Nothing

    ImportSQLtoRange = 0

End Function

I have several subs that run similar SQL strings however will be called at different times. Since I am going about it this way I am trying to append the return recordset to the table created (right now called table1). Each SQL string can have a returned recordset of either zero records, one record or many records.

I am wanting to do it this way to avoid using access to pull the data and then link back from Excel to retrieve. I have other sheets in the workbook that contain data points that will use Index/Match to search this table of data.

I hope this makes sense.

Here is the closest I got to adding it to the table however each run over writes the previous entry. It was placed in the Function just after testing the recordset zero records.

With ThisWorkbook.Sheets("Imports").ListObjects("Table1")
    If Not .DataBodyRange Is Nothing Then
        .DataBodyRange.Delete
    End If

    Call .Range(2, 1).CopyFromRecordset(rst)
End With

Thank you for any time and support.

 

[SkipVought]

Hi,

So you want that last code segment to run, appending the new data to the existing data in table1?

With ThisWorkbook.Sheets("Imports").ListObjects("Table1")
    
    .Range([b].ListRows.Count + 1, [/b]1).CopyFromRecordset(rst)
End With

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Xscatolare]

Thank you Skip however that is not working. Now it inserts at the end of the table? The table range is setup from D1 to E250. It is putting in last row of table with no other data in the table.

 

[SkipVought]

Maybe I misunderstood you, but I thought that's what you were looking for.

Could you please clarify. How many rows prior to running? How many rows after running?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Xscatolare]

My apologies, i may have explained it poorly. Looking to start with a blank table. So run a "clear contents" command to clean out all records in the table. Then run multiple queries to repopulate the table.

Table size to start = 50 records (from last run when it works right)

run code to clear contents in table

table = 0 records

Query 1 = append 1 record
query 2 = append 5 records
query 3 = append 1 record
query 4 = append 10 records

Each query can vary on record return so above is not static just an example of situation.

Does that help clarify?

Thank you again for your time and interest to help me out. I am not a programmer by nature but dabble and it has been mostly in Access so Excel is a new beast for me. Although similar I am quickly realizing there are a log of differences in how you interact with the data.

 

[SkipVought]

I understand what you want.

What result do you get from my code?

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Xscatolare]

it does the same thing and over writes the last entry of the table instead of the first entry.

Here is the code piece that is connecting and writing to the table. Data is good and working like it should, just appending to table is my issue at this point.

Function ImportSQLtoRange(ByVal constring As String, ByVal query As String, target As Range) As Integer

    On Error Resume Next


'ThisWorkbook.Sheets("Imports").Activate


    ' Object type and CreateObject function are used instead of ADODB.Connection,
    ' ADODB.Command for late binding without reference to
    ' Microsoft ActiveX Data Objects 2.x Library

    ' ADO API Reference
    ' [URL unfurl="true"]http://msdn.microsoft.com/en-us/library/ms678086(v=VS.85).aspx[/URL]

    ' Dim con As ADODB.Connection
    Dim con As Object
    Set con = CreateObject("ADODB.Connection")

    con.ConnectionString = constring

    ' Dim cmd As ADODB.Command
    Dim cmd As Object
    Set cmd = CreateObject("ADODB.Command")

    cmd.CommandText = query
    cmd.CommandType = 1         ' adCmdText

    ' The Open method doesn't actually establish a connection to the server
    ' until a Recordset is opened on the Connection object
    con.Open
    cmd.ActiveConnection = con

    ' Dim rst As ADODB.Recordset
    Dim rst As Object
    Set rst = cmd.Execute

    If rst Is Nothing Then
        con.Close
        Set con = Nothing

        ImportSQLtoRange = 1
        Exit Function
    End If

    Dim ws As Worksheet
    Dim col As Integer

    Set ws = target.Worksheet

With ThisWorkbook.Sheets("Imports").ListObjects("Table1")
    
    Call .Range(.ListRows.Count + 1, 1).CopyFromRecordset(rst)
End With
 

    rst.Close
    con.Close

    Set rst = Nothing
    Set cmd = Nothing
    Set con = Nothing

    ImportSQLtoRange = 0

End Function

 

[SkipVought]

Call .Range(.ListRows.Count +[b] 2[/b], 1).CopyFromRecordset(rst)

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Xscatolare]

that got it Skip, thank you! While on here you happen to know command to clear records of the table? I had the table set to 250 records and found that the code was putting it at the bottom of the table and then adding new rows after each run. So I resized the table to D1 to E2 and now it starts at top and inserts each new record.