I'm writing a VBA code to submit records one by one in a recordset loop. Running into this error saying there's a "Duplicate declaration in current scope". I've run into this before when I've accidentally had duplicate variables, but this time I can't see why it's happening. I'm thinking it might have to do with the layout of the script and maybe that it's trying to repeatedly declare it? Maybe I could work around it by declaring the variables in a module? Not sure.
Private Sub submitButton_Click()
Const VmfgConnStr = "Connection string is here"
Dim qdf As QueryDef
Set qdf = CurrentDb.CreateQueryDef("")
Dim sqlString As String
sqlString = "INSERT INTO dbo.TRAINING_RECORDS (EMPLOYEE_ID, DOCUMENT_ID, REVISION, DATE_TRAINED, TRAINED_BY, STATUS, COMPETENCY, APPROVED, TYPE) " & _
"SELECT '" & rst![EMPLOYEE_ID] & "', '" & rst![DOCUMENT_ID] & "', '" & rst![LATEST_REV] & "', '" & dtTrained & "', '" & sprTrained & "', 'T', 'Not Verified', 'NO', 'Internal'"
Set objAD = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objAD.UserName)
strDisplayName = objUser.DisplayName
Dim dtTrainedMsg As String
Dim sprTrainedMsg As String
Dim rst As Recordset
dtTrained = InputBox("Enter date trained as 'mm/dd/yyyy':", "", Format(Date, "mm/dd/yyyy"))
Debug.Print dtTrained
If StrPtr(dtTrained) = 0 Then
Exit Sub
Else
sprTrained = InputBox("Trained By:", "", strDisplayName)
Debug.Print sprTrained
If StrPtr(sprTrained) = 0 Then
Exit Sub
Else
Dim ConfirmMsg, ConfirmStyle, ConfirmTitle, ConfirmResponse
ConfirmMsg = "Continue?"
ConfirmStyle = vbYesNo
ConfirmTitle = " "
ConfirmResponse = MsgBox(ConfirmMsg, ConfirmStyle, ConfirmTitle)
If ConfirmResponse = vbYes Then
recSelect = "SELECT EMPLOYEE_ALL.EMPLOYEE_ID, TRAINING_DOCS_ALL.DOCUMENT_ID, TRAINING_DOCS_ALL.LATEST_REV " & _
"FROM TRAINING_DOCS_ALL, EMPLOYEE_ALL " & _
"WHERE EMPLOYEE_ALL.SELECTED = -1 AND TRAINING_DOCS_ALL.SELECTED = -1"
Set rst = CurrentDb.OpenRecordset(recSelect)
rst.MoveFirst
Do Until rst.EOF
Debug.Print rst![EMPLOYEE_NAME]; rst![DOCUMENT_ID]
qdf.sql = sqlString
qdf.ReturnsRecords = False
qdf.Connect = VmfgConnStr
qdf.Execute
rst.MoveNext
Loop
CurrentDb.Execute "DELETE * FROM TRAINING_RECORDS"
CurrentDb.Execute "INSERT INTO TRAINING_RECORDS (EMPLOYEE_ID, DOCUMENT_ID, REVISION, DATE_TRAINED, TRAINED_BY, STATUS) " & _
"SELECT * FROM uSysTRAINING_RECORDS " & _
"WHERE EMPLOYEE_ID = '" & EMPLOYEE_ID.Value & "'"
CurrentDb.Execute "DELETE FROM TRAINING_NEEDED " & _
"WHERE EMPLOYEE_ID LIKE '" & EMPLOYEE_ID.Value & "' AND DOCUMENT_ID LIKE '" & DOCUMENT_ID.Value & "'"
Else
End If
End If
End If
End Sub
Consider best practices in VBA and SQL generally and MS Access specifically:
VBA Tips
Use Option Explicit at the top of every module. In fact, set it as a global setting in IDE (Tools \ Options \ Require Variable Declaration) which declares line in all VBA projects going forward. This option will raise compile error if variables are used before its corresponding Dim call as many instances emerge in posted code.
Unlike SQL with its lexical order that differs from logical order (i.e., first written clause, SELECT, is usually last clause run), VBA like many other languages runs code in order of how lines are written. Therefore, Dim must come before Set or = assignment .
Related to above, place all Dim calls as top level lines before any application code. This reads better and avoids issues of variable declaration before use.
Const VmfgConnStr = "Connection string is here"
Dim rst As Recordset
Dim qdf As QueryDef
Dim recSelect As String, sqlString As String
Dim dtTrainedMsg As String, dtTrained As String
Dim sprTrainedMsg As String, sprTrained As String
Dim ConfirmMsg As String, ConfirmStyleAs String
Dim ConfirmTitle As String, ConfirmResponse As String
Dim objAd, objUser As Object
Dim strDisplayName As String
Dim Employee_ID_value As String, DOCUMENT_ID_value As String
Consistently indent your code with any blocks such as If, With, For, Do, etc. This facilitates readability and maintainability.
If StrPtr(dtTrained) = 0 Then
...
Else
...
If StrPtr(sprTrained) = 0 Then
...
Else
...
If ConfirmResponse = vbYes Then
...
Do Until rst.EOF ' REDUNDANT WITH insert-select
...
Loop
...
Else ' REDUNDANT IF EMPTY BLOCK
End If
End If
End If
SQL Tips
Use table aliases to avoid re-writing long identifiers.
Avoid looped queries and run insert-select if possible. (See below if parameterization is needed if dtTrained and sprTrained are VBA variables).
INSERT INTO dbo.TRAINING_RECORDS (EMPLOYEE_ID, DOCUMENT_ID, REVISION, DATE_TRAINED,
TRAINED_BY, STATUS, COMPETENCY, APPROVED, TYPE)
SELECT e.EMPLOYEE_ID, t.DOCUMENT_ID, t.LATEST_REV, 'dtTrained', 'sprTrained',
'T', 'Not Verified', 'NO', 'Internal'
FROM TRAINING_DOCS_ALL t, EMPLOYEE_ALL e
WHERE e.SELECTED = -1
AND e.SELECTED = -1
Be careful of cross joins as above uses due to cartesian product that can have performance issues with large tables. (e.g., 1,000 rows X 1,000 rows = 1,000,000 result rows).
If wildcards (*) are not used, don't use LIKE operator which runs a different even slower query process. Instead use equality, =.
Avoid selecting all columns with SELECT * FROM (especially in append queries). See Why is SELECT * considered harmful?.
MS Access Tips
Avoid scripting SQL strings inside VBA. Instead use stored queries with parameterization. Doing so you avoid messy concatenation and punctuation of quotes. This helps in code readability and maintainability, even efficiency as query compiler optimizes saved queries and not string queries run on the fly.
Specifically, replace CurrentDb.Execute ... with the following set up.
SQL (save as stored objects - no concatenation or line breaks)
PARAMETERS [e_id_param] TEXT;
INSERT INTO TRAINING_RECORDS (EMPLOYEE_ID, DOCUMENT_ID, REVISION,
DATE_TRAINED, TRAINED_BY, STATUS)
SELECT EMPLOYEE_ID, DOCUMENT_ID, REVISION, DATE_TRAINED, TRAINED_BY, STATUS
FROM uSysTRAINING_RECORDS
WHERE EMPLOYEE_ID = [e_id_param]
PARAMETERS [e_id_param] TEXT, [doc_id_param] TEXT;
DELETE FROM TRAINING_NEEDED
WHERE EMPLOYEE_ID = [e_id_param] AND DOCUMENT_ID = [doc_id_param]
VBA (call QueryDefs, bind param(s), and execute - no SQL shows in code)
Set qdef = CurrentDb.QueryDefs("mySavedAppendQuery")
qdef![e_id_param] = EMPLOYEE_ID.Value
qdef.Execute
Set qdef = Nothing
Set qdef = CurrentDb.QueryDefs("mySavedDeleteQuery")
qdef![e_id_param] = EMPLOYEE_ID.Value
qdef![doc_id_param] = DOCUMENT_ID.Value
qdef.Execute
Set qdef = Nothing
I want to select and view my data in the database, but it’s proving to be a challenge. Any advice on where I could be missing it? If I run this code even when the select criteria is met, it always returns search failed. Any help?
If txtSun.Text = "SUN" Then
Set rst = New ADODB.Recordset
Dim sSql As String
sSql = "SELECT * FROM SundryProduct WHERE ProdCont='" & txt_con_code.Text & "'"
rst.Open sSql, Cnn, adOpenForwardOnly, , adCmdText
'rst.Open "SELECT * FROM SundryProduct WHERE ProdCont='" & txt_con_code.Text & "' ", Cnn, adOpenForwardOnly, , adCmdText
If rst.EOF Then
MsgBox ("SEARCH FAILED")
Else
MsgBox ("QUANTITY ORDERED " & rst!QuantityOrdered & vbCrLf & " My Load Number is " & rst!LoadNumber)
End If
End If
I am trying to find out if there is a record with a matching ProdCont value in the database, but since I was still trying to make this code work in the first place I have only put messageboxes in the code. I have even tried putting in an actual value that I know exists in the database but it still returns the search failed messagebox even though I know the value exists in the database.
If rst.EOF = True Then '----> here
MsgBox ("SEARCH FAILED")
Else
MsgBox ("QUANTITY ORDERED " & rst!QuantityOrdered & vbCrLf & " My Load Number is " & rst!LoadNumber)
End If
What happens is you try to just run a simple query i.e. select * from SundryProduct?
I would start with that and build on it to eliminate the possibilty of coding/syntax causing the error message
I have a system that places an order in ASP, and when an order is submitted, a notification email goes out.
When I submit the order, I get error '80020009' and the line it points to is this:
email_text = email_text & "<html>" & _
That's a simple line that just starts building the html string that fills the email! Isn't error '80020009' supposed to be for SQL statements? Or am I missing something?
The page still continues on and completes the order process, it just shows that error message first.
I realize this question doesn't really provide much detail, but I don't know what else to specify, I'm just at a loss.
EDIT: Here's some SQL that is a few lines up from that line. Not sure how this would cause the issue, since it's telling me it's on that email line, but it can't hurt to throw it in:
str = "SELECT creation_date, supplier FROM argus.PURCHASE_ORDER WHERE purchase_order = '" & Trim(Request.Form("order_id")) & "' AND customer = '" & Session("customer_id") & "' AND store = '" & Session("store_id") & "' AND userid = '" & Session("user_id") & "'"
Set rst = ConnFW.Execute(str)
str2 = "SELECT a.store_name, a.address1, a.address2, a.city, a.state_cd, a.zipcode, b.customer_name, c.supplier_account FROM argus.STORE a, argus.CUSTOMER b, argus.ELIGIBLE_SUPPLIER c WHERE a.customer = b.customer AND a.customer = c.customer AND a.store = " & Session("store_id") & " AND b.customer = " & Session("customer_id") & " AND c.supplier = " & Trim(rst("supplier")) & ""
Set rst2 = ConnFW.Execute(str2)
Can you provide additional code? There isn't anything wrong with your code except you need to make sure you have something on the line following the underscore:
email_text = email_text + "<html>" & _
""
-- EDIT
Thanks for posting your edits. I see a couple potential issues. In your second recordset object, your trying to access rst("supplier"), but that field hasn't been read yet. Instead of using connfw.execute(str) which is used to execute sql statements like INSERT, UPDATE and DELETE, use rst.open which is used with SELECT.
Try something like:
supplier = ""
rst.open str, connfw
if not rst.eof then
supplier = rst("supplier")
end if
rst.close
Then use supplier in your 2nd sql statement. Also, if the supplier field from the eligible_supplier table is a string, you need to wrap single quotes around that field in your where clause.
I am completely new to Visual Basic. I am working with a MYSQL data base and I want to use VB in excel so I can work with more complex queries. For some reason, when I try to join tables in vb, I get an error message. Can somebody tell me what is wrong with my code.
strSql = "SELECT COUNT(*)FROM `order`" & _
"JOIN user ON user.id = order.destination_id" & _
"WHERE payment_status = 'pay';"
rs.Open strSql, oConn, adOpenDynamic, adLockPessimistic
res = rs.GetRows
rs.Close
Range("A1", "A6") = res(0, 0)
your current query will produce this string,
SELECT COUNT(*)FROM `order`JOIN user ON user.id = order.destination_idWHERE payment_status = 'pay';
^ ^ ^
you lack space during your concatenation, in order to correct that, simply add space before double quote.
strSql = "SELECT COUNT(*) FROM `order` " & _
"JOIN user ON user.id = order.destination_id " & _
"WHERE payment_status = 'pay';"
I have the following coding for a button. My problem is that the Query "SQLStory" is comming up with an error that it is missing a semi colon.
The combobox contains the item name and is ordered by the product ID and the SQLStory is supposed to move all items from the TblTotalSale to the table TblSaleStore. Any Ideas where the error is?
Private Sub StockOK_Click()
Dim SQLDelete1 As String
Dim SQLDelete2 As String
Dim SQLUpdate As String
Dim SQLStory As String
SQLDelete1 = "DELETE * FROM TblStock WHERE TblStock.ProductID = " & CboStockItem.Value
SQLDelete2 = "DELETE * FROM TblTotalSale WHERE TblTotalSale.ProductID = " & CboStockItem.Value
SQLUpdate = "INSERT INTO TblStock (ProductID, StockLevel) VALUES ( " & Me.CboStockItem.Value & "," & Me.TxtStockValue & " )"
SQLStory = "INSERT INTO TblSaleStore (ProductID) VALUES (TblTotalSale.ProductID) FROM TblTotalSale WHERE TblTotalSale.ProductID = " & Me.CboStockItem.Value
If IsNull(Me.TxtStockValue) Then MsgBox "Please Select An Item To Update Stock And Ensure A Value Has Been Entered" Else:
DoCmd.RunSQL SQLDelete1
DoCmd.SetWarnings False
DoCmd.RunSQL SQLStory
DoCmd.RunSQL SQLDelete2
DoCmd.RunSQL SQLUpdate
DoCmd.SetWarnings True
End Sub
Another problem I am having with this code is that the block of doCmd was happening whether the txt box TxtStockValue was null or not, and I only want them to happen if the box is not null... Any Ideas on that part either?
Thanks
Sam
Values are for just that, values such as 'abc' or 123, you need SELECT:
SQLStory = "INSERT INTO TblSaleStore (ProductID) " _
& "SELECT (TblTotalSale.ProductID) FROM " _
& "TblTotalSale WHERE TblTotalSale.ProductID = " _
& Me.CboStockItem.Value
But the above is odd, because you already have the ID in the combo, so, as I said in your previous post on the topic:
SQLStory = "INSERT INTO TblSaleStore (ProductID) " _
& "VALUES ( " & Me.CboStockItem.Value & " )"
Also, it was suggested to you that you should use debug.print when using SQL, this would allow you to view the SQL and paste it into the query design window to see if it worked. The debug.print line can be commented out when everything is working. When you are unfamiliar with SQL, there is a lot to be said for using the query design window to build your queries. You can then cut the SQL from SQL View and add quotes etc.
EDIT re Question Part 2
Dim db As Database
Set db = CurrentDB
If IsNull(Me.TxtStockValue) Then
MsgBox "Please Select An Item To Update Stock " _
& "And Ensure A Value Has Been Entered"
Else
db.Execute SQLDelete1, dbFailOnError
''DoCmd.SetWarnings False
db.Execute SQLStory, dbFailOnError
db.Execute SQLDelete2, dbFailOnError
db.Execute SQLUpdate, dbFailOnError
''DoCmd.SetWarnings True
End If