Trying to find VBA code to append results from QueryDef recordset to an MS Access table

I think you mean something like this :

Public Function CreateTableFromRecordSet(ByRef rst As DAO.Recordset, TableName As String)
Dim tdf As DAO.TableDef
Dim tdf2 As DAO.TableDef
Dim fld As DAO.field
Dim dbs As DAO.Database
Dim i As Integer
'On Error Resume Next
Dim sFields As String
Dim sData As String
Dim field As field
Dim fieldType As Integer
Dim rstTable  As DAO.Recordset
Set dbs = CurrentDb
For Each tdf2 In dbs.TableDefs
  If tdf2.NAME = TableName Then DoCmd.DeleteObject acTable, TableName
Next

Set tdf = dbs.CreateTableDef(TableName)
'/this would build your table
For i = 0 To rst.Fields.Count - 1
fieldType = rst.Fields(i).Type
If rst.Fields(i).Type = 20 Or rst.Fields(i).Type = 131 Then fieldType = 7
If rst.Fields(i).Type = 135 Then fieldType = 8
If rst.Fields(i).Type = 3 Then fieldType = 4
If rst.Fields(i).Type = 131 Then fieldType = 7
If rst.Fields(i).Type = 129 Or rst.Fields(i).Type = 200 Then fieldType = 10
Set field = tdf.CreateField(rst.Fields(i).NAME, fieldType)
If fieldType = 10 Then field.AllowZeroLength = True
tdf.Fields.Append field

  
  'sFields = rst.Fields(i).NAME & ","
Next i

dbs.TableDefs.Append tdf
rst.MoveFirst
Set rstTable = CurrentDb.OpenRecordset(TableName, dbOpenDynaset)
While Not rst.EOF
With rstTable
    .AddNew
        For i = 0 To rst.Fields.Count - 1
            .Fields(i) = rst.Fields(i)
        Next
    .Update
End With
rst.MoveNext
Wend
End Function

Select allOpen in new window

Its a little messy because i am in the middle of refactoring it for a client of mine but it should do the job

I managed to get it working with the following code but if possible I would like to try and adjust this so that instead of deleting and repopulating tblTEMPFinalTV it would perform a Make Table and wipe the table out each time.

When deleting the data from the table and re-populating it , the Access file size starts to grow and needs to be compacted eventually. If I can do a make table I get around that issue.

    Dim qdf As DAO.QueryDef, rst As DAO.Recordset
    DoCmd.Echo False
    Me.TimerInterval = 0
    Set qdf = CurrentDb.CreateQueryDef("")
    qdf.Connect = "ODBC;Description=EpicorLive10;DRIVER=SQL Server;SERVER=SE10SQL0;UID=AccessUserRO;PWD=Seyer123;DATABASE=EpicorLive10"
    qdf.SQL = "spFinalTV"
    qdf.ReturnsRecords = True
    Set rst = qdf.OpenRecordset
    rst.MoveFirst
    DoCmd.SetWarnings False
    DoCmd.RunSQL ("DELETE * FROM tblTEMPFinalTV")
    Do Until rst.EOF
        isql = "INSERT INTO tblTEMPFinalTV (GroupName,JobNum,PartName,PartNum,TotSales,Qty,Status,SOSource,PONBD) " & _
               "VALUES('" & rst.Fields("GroupName") & "', '" & rst.Fields("JobNum") & "', '" & rst("PartName") & "', '" & rst.Fields("PartNum") & "', " & Nz(rst.Fields("TotSales"), 0) & _
               ", " & Nz(rst.Fields("Qty"), 0) & ", '" & rst("Status") & "', '" & rst.Fields("SOSource") & "', '" & CDate(Nz(rst.Fields("PONBD"), "01/01/1900")) & "')"
        DoCmd.RunSQL (isql)
        rst.MoveNext
    Loop
    DoCmd.SetWarnings True
    Me.sfrmFinalTVTopJobs.Requery
    Me.sfrmFinalTVCore.Requery
    Me.sfrmFinalTVGAC.Requery
    Me.sfrmFinalTVUTAS.Requery
    Me.sfrmFinalTVPriority.Requery
    Me.TimerInterval = 60000
    DoCmd.Echo True

Select allOpen in new window

John, thanks for your response. I'm looking at what you provided there but it may be a little much for me to digest. I'm going to look through it some more and see if I can make something work with it.

DoCmd.RunSQL (isql)

I'll suggest to use the execute methode of the database object instead, because with your code, if the query fail, it will remain silent (and you'll wonder why your data arn't there).

The execute method support an optional parameter wich will raise an error (that you can catch) if needed.

Sample code:

Sub Precedure()
On Error Goto Error
    Dim db As DAO.Database
    Set db = CurrentDb

    Dim sql As String
    sql = "INSERT INTO ......."

    db.Execute sql, dbFailOnError
Exit Sub
Error:
    '// Error Handler code here
End Sub

Select allOpen in new window

If the table format is static, simply run an Access append query that selects the data from a pass-through query that runs the stored procedure.  You will of course have to delete the table contents first.

Both Make-table queries and delete/append sets of queries have the same problem and inefficiencies so one isn't better or worse than the other.  They are both bad in that they create bloat.  It could actually be better to render the table in SQL Server if you are looking for efficiency and only need to build the recordset once per day.  That said, I occasionally have a need to import data from a number of server-side tables and because our connection to the server is slow and day old data is adequate for our reporting, I use a "side-table" concept.  I create a template with all the table definitions I need.  Then at the start of the process to get the data we need today, I copy the template to overlay yesterday's version and then run append queries to populate the template.  That way, everyone uses the same data all day and I don't have to worry about bloating my BE.

Well the bloating on the DROP/MAKE table code I setup is a total bummer. I thought for sure that was only the case when deleting/appending data to tables in Access.

My main goal was to prevent having any linked tables or pass through queries as I can't seem to get around network errors. I do have some displays running that update every 2 seconds on a bunch of machines that perform all the connectivity in SQL. Those are bulletproof to network issues of any kind but I append all the data that displays on the forms to an array in SQL.

Unfortunately with this display I'm working on I have more data than that and building an array to post this out on when be a total pain. I suppose it is not out of the question but would suck.

Here is the code I ended up using that works great (less the fact that the file size is growing).

Private Sub UpdateData()
    Dim qdf As DAO.QueryDef, rst As DAO.Recordset, db As DAO.Database
   On Error GoTo UpdateData_Error

    Set db = CurrentDb
    DoCmd.Echo False
    Me.TimerInterval = 0
    Set qdf = CurrentDb.CreateQueryDef("")
    qdf.Connect = "ODBC;Description=EpicorLive10;DRIVER=SQL Server;SERVER=SE10SQL0;UID=AccessUserRO;PWD=Seyer123;DATABASE=EpicorLive10"
    qdf.SQL = "spFinalTV"
    Set rst = qdf.OpenRecordset
    Me.sfrmFinalTVTopJobs.Form.RecordSource = ""
    Me.sfrmFinalTVCore.Form.RecordSource = ""
    Me.sfrmFinalTVGAC.Form.RecordSource = ""
    Me.sfrmFinalTVUTAS.Form.RecordSource = ""
    Me.sfrmFinalTVPriority.Form.RecordSource = ""
    DoCmd.RunSQL "DROP TABLE tblTEMPFinalTV"
    DoCmd.RunSQL "CREATE TABLE tblTEMPFinalTV " & _
                 "(GroupName VARCHAR, JobNum VARCHAR, PartName VARCHAR, PartNum VARCHAR, TotSales NUMBER, Qty NUMBER, Status VARCHAR, SOSource VARCHAR, PONBD DATETIME )"
    rst.MoveFirst
    Do Until rst.EOF
        isql = "INSERT INTO tblTEMPFinalTV (GroupName,JobNum,PartName,PartNum,TotSales,Qty,Status,SOSource,PONBD) " & _
               "VALUES('" & rst("GroupName") & "', '" & rst("JobNum") & "', '" & rst("PartName") & "', '" & rst("PartNum") & "', " & Nz(rst("TotSales"), 0) & _
               ", " & Nz(rst("Qty"), 0) & ", '" & rst("Status") & "', '" & rst("SOSource") & "', '" & CDate(Nz(rst("PONBD"), "01/01/1900")) & "')"
        db.Execute isql, dbFailOnError
        rst.MoveNext
    Loop
    Me.sfrmFinalTVTopJobs.Form.RecordSource = "SELECT tblTEMPFinalTV.GroupName, tblTEMPFinalTV.JobNum, tblTEMPFinalTV.PartName, tblTEMPFinalTV.PartNum, " & _
                                              "tblTEMPFinalTV.Qty, tblTEMPFinalTV.TotSales " & _
                                              "FROM tblTEMPFinalTV " & _
                                              "WHERE (((tblTEMPFinalTV.GroupName) = 'TopJobs')) " & _
                                              "ORDER BY tblTEMPFinalTV.TotSales DESC;"
    Me.sfrmFinalTVCore.Form.RecordSource = "SELECT tblTEMPFinalTV.GroupName, tblTEMPFinalTV.JobNum, tblTEMPFinalTV.PartName, tblTEMPFinalTV.PartNum, " & _
                                           "tblTEMPFinalTV.Status, tblTEMPFinalTV.SOSource, tblTEMPFinalTV.PONBD, tblTEMPFinalTV.Qty, CDate([PONBD]) AS [Date] " & _
                                           "FROM tblTEMPFinalTV " & _
                                           "WHERE (((tblTEMPFinalTV.GroupName) = 'CORE')) " & _
                                           "ORDER BY CDate([PONBD]);"
    Me.sfrmFinalTVGAC.Form.RecordSource = "SELECT tblTEMPFinalTV.* " & _
                                          "FROM tblTEMPFinalTV " & _
                                          "WHERE (((tblTEMPFinalTV.GroupName) = 'GAC')) " & _
                                          "ORDER BY CDate([PONBD]);"
    Me.sfrmFinalTVUTAS.Form.RecordSource = "SELECT tblTEMPFinalTV.* " & _
                                          "FROM tblTEMPFinalTV " & _
                                          "WHERE (((tblTEMPFinalTV.GroupName) = 'UTAS')) " & _
                                          "ORDER BY CDate([PONBD]);"
    Me.sfrmFinalTVPriority.Form.RecordSource = "SELECT tblTEMPFinalTV.* " & _
                                          "FROM tblTEMPFinalTV " & _
                                          "WHERE (((tblTEMPFinalTV.GroupName) = 'IMMEDIATE')) " & _
                                          "ORDER BY CDate([PONBD]);"
    DoCmd.Echo True

   On Error GoTo 0
   Exit Sub

UpdateData_Error:
            
            Select Case Err.Number
                Case 3151, 3146, 2114, 2220
                    Call ErrLog("frmFinalTV", "N/A", Err.Number, Err.Description, Erl, "UpdateData")
                    Set rst = Nothing
                    Set qdf = Nothing
                    Set db = Nothing
                    Reconnect
                    Exit Sub
                Case Else
                    Call ErrHndlr("frmFinalTV", "N/A", Err.Number, Err.Description, Erl, "UpdateData")
                    Exit Sub
            End Select
End Sub

Select allOpen in new window

What network errors are you getting?  The suggestion I gave you is the only way to avoid bloat.