Convert INSERT INTO table FROM DNS passthrough query to DNS-less passthrough query

[waubain]

I have 4 DNS pass through queries (Access 2010 in a shared folder) that worked fine on my computer, but now new end users at different computers need to use them. I think I understand why this failed on their computer, but I do not want to build a DNS connection for each end user as this changes on a regular basis. I do not have administrative rights so I am trying to build a DNS-less connection to our SQL Server. The pass-through SQL is quite complex and lengthly so I would like to continue to use that stored pass-through query in possible.

This was the SQL string that worked on my computer.

strSQL = "INSERT INTO tblGoalINR SELECT * FROM ptqryGoalINR;"
DoCmd.RunSQL(strSQL)

The examples I can find use QueryDefs. I have tried multiple iterations, and I either get the wizard to build a new DNS connection or currently I get a error 3065 which states it cannot execute a SELECT query. I believe the problem is the .Execute.

I am open to current changes or a different direction so any end user with privledges to the Server can run this query.

Public Sub RunPassThroughQuery()

    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim qdfNew As DAO.QueryDef
    Dim strConnectionString As String
  
    Set db = CurrentDb
    Set qdf = db.QueryDefs("ptqryGoalINR")
        
    'Connection string to SQL Server
    strConnectionString = "ODBC; Provider=SQLOLEDB.1; Integrated Security=SSPI;Persist Security Info=True;Data Source=MyServer;Initial catalog=MyDatabase"
    
    'Set the DNS-less connection string
    'qdf.Connect = strConnectionString
    
    'Create a new temporary QueryDef as an Action query
     Set qdfNew = db.CreateQueryDef("", "INSERT INTO tblGoalINR SELECT * FROM ptqryGoalINR;")
    
    'Set the DNS-less connection string
    qdfNew.Connect = strConnectionString
    
    'Run Action query with pass-through query
    qdfNew.Execute dbFailOnError
    
    ' Close connection
    qdfNew.Close
    
    ' Clean up objects
    Set qdf = Nothing
    Set qdfNew = Nothing
    Exit Sub
End Sub

You don't know what you don't know...

 

[waubain]

I got this working. I had some difficulty getting the recordset from the pass-through query to my table. I am not sure it is the most efficient, but it is functioning.

Public Sub RunPassThroughQuery()

    Dim db As Database
    Dim qdf As QueryDef
    Dim qdfNew As QueryDef
    Dim strConnectionString As String
    Dim rst As Recordset, rstINR As Recordset
    
    Set db = CurrentDb
    Set qdf = db.QueryDefs("ptqryGoalINR")
    
    'Connection string to SQL Server
    strConnectionString = "ODBC; DRIVER= {SQL Server}; Server=MyServer; Database=MyDatabase; Trusted_Connection = YES;"

    'Set the connection string
    qdf.Connect = strConnectionString
    qdf.ReturnsRecords = True
    
    'Create temp QueryDef
    Set qdfNew = db.CreateQueryDef("")
    qdfNew.SQL = "SELECT * FROM ptqryGoalINR"
    
    'Set from and to recordsets
    Set rst = qdfNew.OpenRecordset()
    Set rstINR = db.OpenRecordset("tblGoalINR")
    
    'add records to access table
    With rst
        Do While Not .EOF = True
            rstINR.AddNew
                rstINR!PatientID = .Fields("PatientID")
                rstINR!GoalINR = .Fields("GoalINR")
            rstINR.Update
            .MoveNext
        Loop
        .Close
    End With
    
    ' Close 
    qdf.Close
    qdfNew.Close
    rstINR.Close
    db.Close
    
    ' Clean up objects
    Set qdf = Nothing
    Set qdfNew = Nothing
    Set rst = Nothing
    Set rstINR = Nothing
    Set db = Nothing
    Exit Sub
End Sub

You don't know what you don't know...