I have a situation where I need to run a pass through append/insert query of values from MS-Access 2010 VBA to SQL Server 2012, which I have working fine, but that may at some future point need to work with over 1000 records, so I need to make sure my code will accommodate that. My idea was to use modulo to determine when I hit the 1000th record to add a new ; insert ...., to the pass through string, not sure if it's the best approach anyway but I'm struggling to work with .AbsolutePosition.
So far I have:
Dim rs As DAO.Recordset
Dim strsql As String
Set rs = CurrentDb.OpenRecordset("MyTable")
strsql = "insert into [dbo].[SomeTable](field1, field2) values"
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
msgbox rs.AbsolutePosition 'error with whatever I do here
'Something like the below is what I actually want to get to
'If rs.AbsolutePosition Mod 999 = 0 Then strsql = Left(strsql, Len(strsql) - 1) & "; insert into [dbo].[SomeTable](field1, field2) values"
strsql = strsql & " (" & rs!field1 & "," & rs!field2 & "'),"
rs.MoveNext
Loop
strsql = Left(strsql, Len(strsql) - 1) & ";"
Else
MsgBox "No Data"
Exit Sub
End If
I keep getting an error operation is not supported for this type of object when either trying to return or perform a calculation using rs.AbsolutePosition
From the documentation:
The AbsolutePosition property isn't available on forward–only–type Recordset objects, or on Recordset objects opened from pass-through queries against Microsoft Access database engine-connected ODBC databases.
Why not simply use a running counter?
Do Until rs.EOF = True
i = i + 1
If i Mod 1000 = 0 Then
' ...
Edit
/Fail. Your rs isn't from a Pass-Through query, so that's not the issue. Nevertheless, the running counter seems like the easiest option.
Related
So, being newish to access and only using VBA in excel up until a few months ago there are quite a few commands I have absolutely 0 idea on how to use/correctly write syntax.
Problem: I have a saved query (qry_ExcelExport) which at the moment is just:
SELECT '*' FROM tbl_Contacts
What I want to do is use VBA to add/change the WHERE clause based on a user form control.
Something like:
If me.txt_Flag = "DP Delegate" then 'WHERE [DP-DEL] = True' (or = -1)
Elseif me.txt_Flag = "DP Sponsor" then 'WHERE [DP-SPON] = True' (or = -1)
And so on. (I understand that the syntax above is 100% incorrect, that's just what I'm hoping to achieve)
Using the power of the internet I managed to come across this code:
‘To change the Where clause in a saved query
Dim qdf as QueryDef
Dim db as Database
Set db = CurrentDB
Set qdf = db.QueryDefs("YourQueryName")
qdf.SQL = ReplaceWhereClause(qdf.SQL, strYourNewWhereClause)
set qdf = Nothing
set db = Nothing
Public Function ReplaceWhereClause(strSQL As Variant, strNewWHERE As Variant)
On Error GoTo Error_Handler
‘This subroutine accepts a valid SQL string and Where clause, and
‘returns the same SQL statement with the original Where clause (if any)
‘replaced by the passed in Where clause.
‘
‘INPUT:
‘ strSQL valid SQL string to change
‘OUTPUT:
‘ strNewWHERE New WHERE clause to insert into SQL statement
‘
Dim strSELECT As String, strWhere As String
Dim strOrderBy As String, strGROUPBY As String, strHAVING As String
Call ParseSQL(strSQL, strSELECT, strWhere, strOrderBy, _
strGROUPBY, strHAVING)
ReplaceWhereClause = strSELECT &""& strNewWHERE &""_
& strGROUPBY &""& strHAVING &""& strOrderBy
Exit_Procedure:
Exit Function
Error_Handler:
MsgBox (Err.Number & ": " & Err.Description)
Resume Exit_Procedure
End Function
And that first line... that very first line "To change the Where clause in a saved query" indicates that this is EXACLY what I need.
But, there is no walk-through or step-by-step beginners guide to understanding this code, the syntax or more importantly how to tie it in with a form control and it is not one I've ever used or heard of before.
EDIT: The saved query qry_ExcelExport is used in a funtion to export data
Call exportTable("qry_ExportExcel")
Where I'm calling
Public Sub exportTable(tName As String)
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, tName, saveFileAs, True
End Sub
I need the ability to modify the where so that when I export it includes that clause as at the moment there is no WHERE clause so exports just take all the data.
It is normally neither needed nor practical to modify saved queries for filtering.
What you do instead is apply the filter to the form:
If me.txt_Flag = "DP Delegate" then
strFilter = "[DP-DEL] = True"
Elseif me.txt_Flag = "DP Sponsor" then
strFilter = "[DP-SPON] = True"
Else
strFilter = ""
End If
Me.Filter = strFilter
Me.FilterOn = (strFilter <> "")
Or if you need the query for something else, you can apply the filter to the query.
Set rs = DB.OpenRecordset("Select * From MySavedQuery Where " & strFilter)
Edit
If the query is used for export, it is actually one of few situations, where modifying the query is useful.
If the query is as simple as in your question, you can simply set the full SQL:
strSql = "SELECT * FROM tbl_Contacts WHERE " & strFilter
db.QueryDefs("qry_ExportExcel").SQL = strSql
Call exportTable("qry_ExportExcel")
or if the base query is more complex, use two queries: a constant one (qry_ExportExcel_Base) and a dynamic one (qry_ExportExcel)
strSql = "SELECT * FROM qry_ExportExcel_Base WHERE " & strFilter
etc. as above
I am trying to make an Update to a Passthrough query using MS Access to an ODBC server that I have no control over. The reason I have to use a Passthrough is that the records I am accessing have more than 255 fields (I would use a linked table if I could).
I've been using this resource to get the data using Passthrough (http://www.techonthenet.com/access/tutorials/passthrough/basics09.php)
The query is simply: SELECT FullName, PointNumber FROM DNP3.CDNP3AnalogIn
The ODBC Connect Str is: ODBC;DSN=SCX6_DB;LOCATION=Main;UID=admin;PWD=password;LOCALTIME=False;
Now inside an Access Database I have a table (SCADA DB Tags) with same name for the Fields (FullName, PointNumber), and I want to update the fields inside the ODBC Database using an Update Passthrough query, but I am unsure how to do this.
I saved the previous Query as DNP3_CDNP3AnalogIn Query, and tried to make a new Query:
UPDATE [DNP3_CDNP3AnalogIn Query] INNER JOIN [SCADA DB Tags] ON
[DNP3_CDNP3AnalogInQuery].FullName = [SCADA DB Tags].FullName
SET [DNP3_CDNP3AnalogIn Query].[PointNumber] = [SCADA DB Tags].[PointNumber];
But I get an error from Access: Operation must use an updateable query.
I know there is someway to do this but I can't seem to find an example (I might not be googling the correct phrase). Microsoft page (http://technet.microsoft.com/en-us/library/bb188204%28v=sql.90%29.aspx) says: There is, however, one important limitation: the results returned by SQL pass-through queries are always read-only. If you want to enable users to perform updates based on the data retrieved, you must write code to handle this. Unfortunately it doesn't give an example to do it!
Can anyone give me a solution, I can use VBA if required? I can also give more background if required. Unfortunately I'm not an expert in Access, I'm just trying to come up with an automated solution that could save me some time.
When they said that "If you want to enable users to perform updates based on the data retrieved [from a pass-through query], you must write code to handle this" they probably meant something like this:
Option Compare Database
Option Explicit
Public Sub UpdateSqlServer()
Dim cdb As DAO.Database, rst As DAO.Recordset
Dim con As Object ' ADODB.Connection
Dim cmd As Object ' ADODB.Command
Const adParamInput = 1
Const adInteger = 3
Const adVarWChar = 202
Set cdb = CurrentDb
Set rst = cdb.OpenRecordset( _
"SELECT " & _
"[SCADA DB Tags].FullName, " & _
"[SCADA DB Tags].PointNumber " & _
"FROM " & _
"[DNP3_CDNP3AnalogIn Query] " & _
"INNER JOIN " & _
"[SCADA DB Tags] " & _
"ON [DNP3_CDNP3AnalogIn Query].FullName = [SCADA DB Tags].FullName", _
dbOpenSnapshot)
Set con = CreateObject("ADODB.Connection")
con.Open "DSN=SCX6_DB;"
Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = con
cmd.CommandText = _
"UPDATE DNP3.CDNP3AnalogIn SET " & _
"PointNumber=? " & _
"WHERE FullName=?"
cmd.Parameters.Append cmd.CreateParameter("?", adInteger, adParamInput) ' PointNumber
cmd.Parameters.Append cmd.CreateParameter("?", adVarWChar, adParamInput, 255) ' FullName
cmd.Prepared = True
Do Until rst.EOF
cmd.Parameters(0).Value = rst!PointNumber
cmd.Parameters(1).Value = rst!FullName
cmd.Execute
rst.MoveNext
Loop
Set cmd = Nothing
con.Close
Set con = Nothing
rst.Close
Set rst = Nothing
Set cdb = Nothing
End Sub
Notes:
The code uses your existing ODBC DNS.
It uses a Prepared Statement to perform the updates, increasing efficiency and protecting against failures related to SQL Injection.
The source Recordset performs an INNER JOIN on the pass-through query to ensure that the code only tries to update rows on the server that actually exist on the server.
Are you saying that [DNP3_CDNP3AnalogIn Query] is server side based and that table [SCADA DB Tags] is local based? In that case you cannot use a pass-through query.
However since the tables ARE in different locations pass-though cannot touch BOTH at the same time.
You can however execute "single" server side (pass-though) in a loop. If you setup a pass-though query and SAVE it, then this code will work:
Dim qdfPass As DAO.QueryDef
Dim rstLocal As DAO.Recordset
Dim strSQL As String
Dim strSQL2 As String
Set qdfPass = CurrentDb.QueryDefs("MyPass")
strSQL = "UPDATE [DNP3_CDNP3AnalogIn Query] " & _
"SET [DNP3_CDNP3AnalogIn Query].[PointNumber] = 'xxxx' " & _
"WHERE [DNP3_CDNP3AnalogInQuery].FullName = 'zzzz' "
Set rstLocal = CurrentDb.OpenRecordset("[SCADA DB Tags]")
Do While rstLocal.EOF = False
strSQL2 = Replace(strSQL, "xxxx", rstLocal!PointNumber)
strSQL2 = Replace(strSQL2, "zzzz", rstLocal!FullName)
qdfPass.SQL = strSQL2
qdfPass.Execute
rstLocal.MoveNext
Loop
rstLocal.Close
I am working on a system that has been in use since the 90's. Written in VB6, it was originally setup to utilize an Access Database and the JET driver.
Now, since we have clients running up against the 2GB file size limit on Access DBs, we are looking into converting everything over to mySQL.
Unfortunately, everything in the system that was written prior to about 5 years ago is using this type of logic:
Dim rst As New ADODB.Recordset
rst.ActiveConnection = cnn
rst.Open "table"
rst.Index = "index"
rst.Seek Array("field1", "field2"), adSeekFirstEQ
rst!field1 = "something new"
rst.Update
The newer code is using SQL commands like SELECT, UPDATE, etc.
So, what we're hoping to do is to phase in the new mySQL DBs for our clients - get them the DB setup but using all the old code.
The problem is that I can't use Index when using the SQL db... everything else seems to work fine except for that.
I get the error: #3251: Current provider does not support the necessary interface for Index functionality.
Is there something I'm missing? Is there another way to so a Seek when using SQL so that I can sort by my Index? Or will I have to go in and change the entire system and remove all the Seek logic - which is used THOUSANDS of times? This is particularly an issue for all of our Reports where we might have a Table with an Index where Col 1 is sorted ASC, Col 2 is sorted DESC, Col 3 is ASC again and I need to find the first 5 records where Col 1 = X. How else would you do it?
Since, as you posted, the DB doesn't support Seek or Index, you're kind of out of luck as far as that is concerned.
However, if you really must use seek /index I'd suggest importing the result of the SQL query into a local .mdb file and then using that to make the recordset work like the rest of the code expects.
This is slightly evil from a performance point of view, and honestly it may be better to replace all the seeks and index calls in the long run anyways, but at least it'll save you time coding.
For creating the local db you can do:
Function dimdbs(Temptable as String)
Dim tdfNew As TableDef
Dim prpLoop As Property
Dim strDbfullpath As String
Dim dbsn As Database
Dim idx As Index
Dim autofld As Field
'PARAMETERS: DBFULLPATH: FileName/Path of database to create
strDbfullpath = VBA.Environ$("TMP") & "\mydb.mdb"
If Dir(strDbfullpath) <> "" Then
Set dbsn = DBEngine.Workspaces(0).OpenDatabase(strDbfullpath)
Else
Set dbsn = DBEngine.CreateDatabase(strDbfullpath, dbLangGeneral)
End If
Set tdfNew = dbsn.CreateTableDef(Temptable)
With tdfNew
' Create fields and append them to the new TableDef
' object. This must be done before appending the
' TableDef object to the TableDefs collection of the
' database.
Set autofld = .CreateField("autonum", dbLong)
autofld.Attributes = dbAutoIncrField
.Fields.Append autofld
.Fields.Append .CreateField("foo", dbText, 3)
.Fields.Append .CreateField("bar", dbLong)
.Fields.Append .CreateField("foobar", dbText, 30)
.Fields("foobar").AllowZeroLength = True
Set idx = .CreateIndex("PrimaryKey")
idx.Fields.Append .CreateField("autonum")
idx.Unique = True
idx.Primary = True
.Indexes.Append idx
Debug.Print "Properties of new TableDef object " & _
"before appending to collection:"
' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
' Append the new TableDef object to the Northwind
' database.
If ObjectExists("Table", Temptable & "CompletedCourses", "Userdb") Then
dbsn.Execute "Delete * FROM " & Temptable & "CompletedCourses"
Else
dbsn.TableDefs.Append tdfNew
End If
Debug.Print "Properties of new TableDef object " & _
"after appending to collection:"
' Enumerate Properties collection of new TableDef
' object.
For Each prpLoop In .Properties
On Error Resume Next
If prpLoop <> "" Then Debug.Print " " & _
prpLoop.Name & " = " & prpLoop
On Error GoTo 0
Next prpLoop
End With
Set idx = Nothing
Set autofld = Nothing
End Function
to find and delete it later you can use the following:
Function DeleteAllTempTables(strTempString As String, Optional tmpdbname As String = "\mydb.mdb", Optional strpath As String = "%TMP%")
Dim dbs2 As Database
Dim t As dao.TableDef, I As Integer
Dim strDbfullpath
If strpath = "%TMP%" Then
strpath = VBA.Environ$("TMP")
End If
strDbfullpath = strpath & tmpdbname
If Dir(strDbfullpath) <> "" Then
Set dbs2 = DBEngine.Workspaces(0).OpenDatabase(strDbfullpath)
Else
Exit Function
End If
strTempString = strTempString & "*"
For I = dbs2.TableDefs.Count - 1 To 0 Step -1
Set t = dbs2.TableDefs(I)
If t.Name Like strTempString Then
dbs2.TableDefs.Delete t.Name
End If
Next I
dbs2.Close
End Function
To import from SQL to that DB you'll have to get the recordset and add each record in using a for loop (unless it's a fixed ODBC connection, i think you can import directly but I don't have example code)
Dim formrst As New ADODB.recordset
Set mysqlconn = New ADODB.Connection
Dim dbsRst As recordset
Dim dbs As Database
'opens the ADODB connection to my database
Call openConnect(mysqlconn)
'calls the above function to create the temp database
'Temptable is defined as a form-level variable so it can be unique to this form
'and other forms/reports don't delete it
Call dimdbs(Temptable)
Me.RecordSource = "SELECT * FROM [" & Temptable & "] IN '" & VBA.Environ$("TMP") & "\mydb.mdb'"
Set dbs = DBEngine.Workspaces(0).OpenDatabase(VBA.Environ$("TMP") & "\mydb.mdb")
Set dbsRst = dbs.OpenRecordset(Temptable)
Set formrst.ActiveConnection = mysqlconn
Call Selectquery(formrst, strSQL & strwhere & SQLorderby, adLockReadOnly, adOpenForwardOnly)
With formrst
Do Until .EOF
dbsRst.AddNew
dbsRst!foo = !foo
dbsRst!bar = !bar
dbsRst!foobar = !foobar
dbsRst.Update
.MoveNext
Loop
.Close
End With
dbsRst.Close
Set dbsRst = Nothing
dbs.Close
Set formrst = Nothing
You'll have to re-import the data on save or on form close at the end, but at least that will only need one SQL statement, or you can do it directly with the ODBC connection.
This is by far less than optimal but at least you can couch all this code inside one or two extra function calls and it won't disturb the original logic.
I have to give huge credit to Allen Browne, I pulled this code from all over the place but most my code probably comes from or has been inspired by his site (http://allenbrowne.com/)
Who wants to use VB6? Nevertheless...
When you do not specify Provider, you can't use Index property. As far as i know only OleDb for MS Jet supports *Seek* method and *Index* property.
Please read this:
Seek method - http://msdn.microsoft.com/en-us/library/windows/desktop/ms675109%28v=vs.85%29.aspx
Index property - http://msdn.microsoft.com/en-us/library/windows/desktop/ms675255%28v=vs.85%29.aspx
ConnectionString property - http://msdn.microsoft.com/en-us/library/windows/desktop/ms675810%28v=vs.85%29.aspx
Provider property - http://msdn.microsoft.com/en-us/library/windows/desktop/ms675096%28v=vs.85%29.aspx
For further information, please see: http://msdn.microsoft.com/en-us/library/windows/desktop/ms681510%28v=vs.85%29.aspx
[EDIT]
After your comments...
I would strongly recommend to download and install Visual Studio Express Edition and use VB.NET instead VB6. Than install ADO.NET MySQL Connector and re-write application, using the newest technology rather than torturing yourself with ADODB objects, etc.
Examples:
Connecting to MySQL databases using VB.NET
[/EDIT]
I have an ado created recordset in access 2010 it returns 9 different fields from a stored procedure on sql server 2008 r2.
I am trying to use this recordset (which does populate) to insert all of the records into a table that matches the output. My issue is that two of the fields are name fields that have commas in them. For example Smith, Joseph-- I need to insert that comma into the appropriate field. Right now it throws an error because of the comma in the field.
Here is the code that I am using:
Option Compare Database
'Executes the filtering routine
Private Sub cmdApplyFilter_Click()
'If txtStartDate.Value And txtEndDate.Value Is Not Null Then
' QuickFilter
'Else
' DefaultRun
'End If
QuickFilter
'********** Filter as you type **********
'Private Sub txtFilter_Change()
' QuickFilter
'End Sub
End Sub
'Perform the actual filtering on the subform
Private Sub QuickFilter()
Dim Sql As String
Dim filter As String
If txtStartDate = vbNullString Then
'Reset the filter if the textbox is empty
'This will be the default sql statement to fill the subreport
SubForm.Form.FilterOn = False
Else
'Some common substitutions that users may have already inserted as wildchars
filter = Replace(txtStartDate, "%", "*")
filter = Replace("*" & filter & "*", "**", "*")
'Construct the filter for the sql statement
'/*********** GROUP BY GOES HERE ***********/
'Assign the filter to the subform
'SubForm.Form.filter = Sql
'SubFomr.Form.FilterOn = True
End If
End Sub
Private Sub Form_Load()
'Sets up the connection with the sql server database retrieves the stored procedure, executes it and puts the result set into a table
Dim Conn As ADODB.Connection
Dim Cmd As ADODB.Command
Dim Rs As ADODB.Recordset
Dim rs1 As ADODB.Recordset
Dim Connect As String
Dim filter As String
Connect = "Provider =SQLNCLI10; Data Source=10.50.50.140; Initial Catalog=CCVG; User Id = oe; Password = Orth03c0; "
'Establish the connection with sql server
Set Conn = New ADODB.Connection
Conn.ConnectionString = Connect
Conn.Open
'Open the recorset
Set Cmd = New ADODB.Command
Cmd.ActiveConnection = Conn
Cmd.CommandText = "dbo.cusGenNoNotesReport"
Cmd.CommandType = adCmdStoredProc
Set Rs = Cmd.Execute()
Dim x As Integer
If Not Rs.BOF And Not Rs.EOF Then
If Not Rs.BOF Then Rs.MoveFirst
Do Until Rs.EOF
For x = 0 To Rs.Fields.Count - 1
MsgBox Rs.Fields(x)
'DoCmd.RunSQL "INSERT INTO tblNoNotes (Provider, Facility, TicketNumber, Charges, FinancialClass, CPT, CPTDescription, PatientFullName, DateOfEntry) SELECT " & Rs.Fields(x).Value & ""
Next x
Rs.MoveNext
Loop
End If
'Process results from recordset, then close it.
'DoCmd.RunSQL "INSERT INTO tblNoNotes (Provider, Facility, TicketNumber, Charges, FinancialClass, CPT, CPTDescription, PatientFullName, DateOfEntry) VALUES (""" & Rs![Provider] & """,""" & Rs![Facility] & """ & Rs![TicketNumber] & """, """ & Rs![Charges] & """, """ & Rs![FinancialClass] & """, """ & Rs![CPT] & """, """ & Rs![CPTDescription] & """, """ & Rs![PatientFullName] & """, """ & Rs![DateOfEntry] & """ )"
Rs.Open
Rs.Close
Conn.Close
Set Rs = Nothing
Set Cmd = Nothing
Set Conn = Nothing
End Sub
You have an ADO Recordset, Rs, which contains data you want to add to your Access table. Instead of trying to fix the INSERT statement to add each row, it should be easier to open a DAO Recordset for the destination table and store the values from each ADO row by adding a new row the the DAO Recordset. Although this is still a RBAR (row by agonizing row) approach, it should be significantly faster than building and executing an INSERT statement for each row.
First of all, make sure to add Option Explicit to your module's Declarations section.
Option Compare Database
Option Explicit
Then use this code to append the ADO Recordset data to your table.
Dim db As DAO.Database
Dim rsDao As DAO.Recordset
Set db = CurrentDb
Set rsDao = db.OpenRecordset("tblNoNotes", _
dbOpenTable, dbAppendOnly + dbFailOnError)
Do While Not Rs.EOF
rsDao.AddNew
rsDao!Provider.Value = Rs!Provider.Value
rsDao!Facility.Value = Rs!Facility.Value
rsDao!TicketNumber.Value = Rs!TicketNumber.Value
rsDao!Charges.Value = Rs!Charges.Value
rsDao!FinancialClass.Value = Rs!FinancialClass.Value
rsDao!CPT.Value = Rs!CPT.Value
rsDao!CPTDescription.Value = Rs!CPTDescription.Value
rsDao!PatientFullName.Value = Rs!PatientFullName.Value
rsDao!DateOfEntry.Value = Rs!DateOfEntry.Value
rsDao.Update
Rs.MoveNext
Loop
rsDao.Close
Set rsDao = Nothing
Set db = Nothing
Note this approach means you needn't worry about whether PatientFullName contains a comma, or apostrophe ... or struggle with properly quoting field values to produce a valid INSERT statement. You simply store the value from one recordset field to the appropriate field in another recordset.
I think the real problem you're complaining about here is that your data in the ADO Recordset has quotes (sometimes called apostrophes) in it. Anytime quotes could possibly exist in your data you will need to check for and escape them before using the data in an SQL Statement. You will need to know this not only for inserts but also for performing filtering and creating WHERE statements as well. For example:
Replace(Rs![PatientFullName], "'", "''")
A simpler way to do this is to make your own little function. The "PQ" stands for pad quotes. You can name it whatever you want.
PQ(rs![PatientFullName])
Public Function PQ(s as String) as String
PQ = Replace(s, "'", "''")
End Function
But I also agree with HansUp that it's much easier to use recordsets for inserts. I basically never use SQL Insert statements anymore, except for places where I have no option such as SQL Server T-SQL.
Be aware that if you do want to use insert statements, you should consider using the following:
CurrentDb.Execute "INSERT INTO Statement Goes Here", dbFailOnError
This is considered to be a more robust solution than DoCmd.RunSQL, mostly because it runs in the context of the underlying Database Engine instead of the Access interface. Using CurrentDb.Execute prevents you from having to use DoCmd.SetWarning statements to turn off warnings.
I'm using the following code to run a passthrough query. I'm trying to run the passthrough query, then check how many records are returned to figure out if it worked. But I get an error saying
"Invalid Operation"
Why is it doing this and how can I correct?
Dim Item As String
Item = InputBox("Enter Item needing a surrogate UPC.", "Enter Item")
Set db = CurrentDb
Set qdf = db.QueryDefs("spAL_AssignSurrogateUPC")
qdf.ReturnsRecords = True
qdf.SQL = "spAL_AssignSurrogateUPC '" & Item & "'"
With qdf.OpenRecordset(dbOpenSnapshot) '<--- Error triggered here.
If qdf.RecordCount = 1 Then
MsgBox "Surrogate UPC assigned."
Else
MsgBox "ERROR. Could not assign surrogate UPC."
End If
End With
Use the EXEC syntax
qdf.SQL = "EXEC spAL_AssignSurrogateUPC '" & Replace(Item, "'", "''") & "';"
(I assume it's SQL Server.)
I also added a replace function in order to cope with single quotes in the Item string. This also helps prevent SQL injections.
EDIT:
Try to do this, instead of using the With-statement
Dim rs as DAO.Recordset
...
Set rs = qdf.OpenRecordset(dbOpenSnapshot)
If rs.EOF Then
MsgBox "ERROR. Could not assign surrogate UPC."
Else
MsgBox "Surrogate UPC assigned."
End If