Running a stored procedure from Access to populate a local table

[madmax262]

Hi I have created a VB script in Access which runs a stored procedure which retrieves a dataset and I can display it in an Access form.

The records can be displayed but cannot be modified so I am looking to populate a local Access table with the data.

This is the VB that I am using and I require your help to get it to populate the local table?

Dim cn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As ADODB.Recordset
Dim SQLCmd As String

Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset

cn.connectionString = "provider=msdatashape;data provider=SQLOLEDB;Server=123.456.789.012;DATABASE= My_DB;UID=ABCD;PWD=1234;"
cn.Open

With cmd
.ActiveConnection = cn
.CommandText = "SEL_Suppliers_Summary"
.CommandType = adCmdStoredProc
.Parameters.Refresh
End With

With rs
.ActiveConnection = cn
.CursorType = adOpenForwardOnly
.CursorLocation = adUseServer
End With

Set rs = cmd.Execute
Set Me.Recordset = rs


***I WANT TO CAPTURE THE RECORD SET HERE AND ENTER IT IN TO AN ACCESS TABLE NAMED T_Suppliers***


rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

errbox:
If Err.Number > 0 Then

MsgBox Err.Description & " " & Err.Number
Exit Sub

End If

[jforbes]

This would be pretty much automatic if you connected Access to SQL through ODBC. I would look at this article: Import or link to SQL Server data. Specifically "Link to SQL Server data", about half way down the page. By going this route, you won't need any VBA code in Access and it will work with the SQL Table Natively with live SQL Data.

[madmax262]

I am very familiar with connecting an Access frontend to a SQL backend via ODBC. The reason I want to avoid this is because the backend is hosted with an ISP and the Access frontend is local on PCs'.

Access would want to open the whole table and download it to the work station which is not an option as the Internet may drop resulting in a corrupted db. Hence the reason that I want to run a SP and return only 1 or a limited amount of records for processing locally.

[jforbes]

Given that you have the RecordSet opening, this is roughly how I would go about cloning the Data:

Dim sSQL As String
...
Set rs = cmd.Execute
 
' Loop Through the SQL Records and Insert into the Local Table
While Not rs.EOF
    sSQL = ""
    sSQL = sSQL & "INSERT INTO T_Suppliers ("
    sSQL = sSQL & "  Field1"
    sSQL = sSQL & ", Field2"
    sSQL = sSQL & ", Field3"
    sSQL = sSQL & ") VALUES ("
    sSQL = sSQL & "  '" & NZ(rs!Field1, "") & "' "
    sSQL = sSQL & ", '" & NZ(rs!Field2, "") & "' "
    sSQL = sSQL & ", '" & NZ(rs!Field3, "") & "' "
    sSQL = sSQL & ")"
 
    CurrentDB.Execute sSQL, dbFailOnError
    rs.MoveNext
Wend

[madmax262]

I added this code but it errors with Runtime error '3709':

This connection cannot be used to perform this operation. It is either closed or invalid in this context.


The code now looks like: -

Dim cn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As ADODB.Recordset
Dim SQLCmd As String
Dim sSQL As String

Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset

cn.connectionString = "provider=msdatashape;data provider=SQLOLEDB;Server=123.456.789.012;DATABASE= My_DB;UID=ABCD;PWD=1234;"
cn.Open


Set rs = cmd.Execute

While Not rs.EOF

sSQL = ""
sSQL = sSQL & "INSERT INTO T_Suppliers ("
aSQL = aSQL & " Supplier_No"
aSQL = aSQL & ", Supplier_Code"
aSQL = aSQL & ", Supplier"
aSQL = aSQL & ", Branch_No"
aSQL = aSQL & ", Contact"
aSQL = aSQL & ", Address_1"
aSQL = aSQL & ", Address_2"
aSQL = aSQL & ", Address_3"
aSQL = aSQL & ", Address_4"
aSQL = aSQL & ", Address_5"
aSQL = aSQL & ", Phone_No"
aSQL = aSQL & ", Fax_No"
aSQL = aSQL & ", Credit_Limit"
aSQL = aSQL & ", Account_Status_No"
aSQL = aSQL & ", Active_Record"
aSQL = aSQL & ", Entered_By"
aSQL = aSQL & ", Entered_Date"
aSQL = aSQL & ", Entered_IP_Address"
aSQL = aSQL & ", Modified_By"
aSQL = aSQL & ", Modified_Date"
aSQL = aSQL & ", Modified_IP_Address"
aSQL = aSQL & ") VALUES ("
aSQL = aSQL & " '" & Nz(Supplier_No, "") & "' "
aSQL = aSQL & ", '" & Nz(Supplier_Code, "") & "' "
aSQL = aSQL & ", '" & Nz(Supplier, "") & "' "
aSQL = aSQL & ", '" & Nz(Branch_No, "") & "' "
aSQL = aSQL & ", '" & Nz(Contact, "") & "' "
aSQL = aSQL & ", '" & Nz(Address_1, "") & "' "
aSQL = aSQL & ", '" & Nz(Address_2, "") & "' "
aSQL = aSQL & ", '" & Nz(Address_3, "") & "' "
aSQL = aSQL & ", '" & Nz(Address_4, "") & "' "
aSQL = aSQL & ", '" & Nz(Address_5, "") & "' "
aSQL = aSQL & ", '" & Nz(Phone_No, "") & "' "
aSQL = aSQL & ", '" & Nz(Fax_No, "") & "' "
aSQL = aSQL & ", '" & Nz(Credit_Limit, "") & "' "
aSQL = aSQL & ", '" & Nz(Account_Status_No, "") & "' "
aSQL = aSQL & ", '" & Nz(Active_Record, "") & "' "
aSQL = aSQL & ", '" & Nz(Entered_By, "") & "' "
aSQL = aSQL & ", '" & Nz(Entered_Date, "") & "' "
aSQL = aSQL & ", '" & Nz(Entered_IP_Address, "") & "' "
aSQL = aSQL & ", '" & Nz(Modified_By, "") & "' "
aSQL = aSQL & ", '" & Nz(Modified_Date, "") & "' "
aSQL = aSQL & ", '" & Nz(Modified_IP_Address, "") & "' "
aSQL = aSQL & ")"

CurrentDb.Execute sSQL, dbFailOnError
rs.MoveNext

Wend

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

errbox:
If Err.Number > 0 Then

MsgBox Err.Description & " " & Err.Number
Exit Sub

End If

[jforbes]

I'm not familiar with that error and Google and Microsoft seems to be a bit ambiguous about the causes.

One possible cause is that the database connection is probably closed when the code doesn't expect it. Where the other is Indexing on a Memo Field.

It might be easer if you could debug it a little and try to determine what line is causing the error.

[madmax262]

I managed to get it to work using this code: -

Dim cn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As ADODB.Recordset
Dim SQLCmd As String
Dim sSQL As String

Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset

cn.connectionString = "provider=msdatashape;data provider=SQLOLEDB;Server=123.456.789.012;DATABASE= My_DB;UID=ABCD;PWD=1234;"
cn.Open

Set rs = cmd.Execute
Set Me.Recordset = rs

Do Until rs.EOF

CurrentDb.Execute "INSERT INTO T_Suppliers(Supplier_No, Supplier_Code, Supplier, Address_1, Address_2, Address_3, Address_4, Address_5, Phone_No, Fax_No, Credit_Limit, Account_Status_No, Active_Record, Entered_By, Entered_Date, Entered_IP_Address, Modified_By, Modified_Date, Modified_IP_Address) VALUES('" & rs("Supplier_No") & "','" & rs("Supplier_Code") & "','" & rs("Supplier") & "','" & rs("Address_1") & "','" & rs("Address_2") & "','" & rs("Address_3") & "','" & rs("Address_4") & "','" & rs("Address_5") & "','" & rs("Phone_No") & "','" & rs("Fax_No") & "','" & rs("Credit_Limit") & "','" & rs("Account_Status_No") & "','" & rs("Active_Record") & "','" & rs("Entered_By") & "','" & rs("Entered_Date") & "','" & rs("Entered_IP_Address") & "','" & rs("Modified_By") & "','" & rs("Modified_Date") & "','" & rs("Modified_IP_Address") & "')"

rs.MoveNext

Loop

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

errbox:
If Err.Number > 0 Then

MsgBox Err.Description & " " & Err.Number
Exit Sub

End If

[ADezii]

Another possible approach would be to create a parallel ADODB Recordset to populate the T_Suppliers Table:

'*******************************************************
Dim rst2 As ADODB.Recordset
Set rst2 = New ADODB.Recordset
Dim intFldCtr As Integer
 
With rst2
  .Source = "T_Suppliers"
  .ActiveConnection = CurrentProject.Connection
  .CursorType = adOpenDynamic
  .LockType = adLockOptimistic
    .Open
End With
 
With rs
  Do While Not .EOF
    rst2.AddNew
      For intFldCtr = 0 To .Fields.Count - 1
        rst2.Fields(intFldCtr) = .Fields(intFldCtr)
      Next
    rst2.Update
      .MoveNext
  Loop
End With
'*******************************************************