I have the code below for updating data from both textbox and listbox into two related tables. Unfortunately it brings an error. What might I be doing wrong?
Db.Execute "INSERT INTO tblinvoice(InvoiceID,InvoiceNo,InvoiceDate,CustomerID,SalesmanID,Remarks) VALUES('" & txtInvoiceID.Value & "','" & txtInvoiceNo.Value & "','" & txtInvoiceDate.Value & "','" & txtCustomerID.Value & "','" & txtSalesManID.Value & "','" & txtRemark.Value & "')"
Private Sub btnSave_Click()
If txtSalesManID.Value = "" Then
MsgBox "Please Retrieve Sales Man ID.", vbInformation, "Choose SalesMan"
txtSalesManID.SetFocus
Exit Sub
End If
For i = 0 To listBox1.ListCount - 1 Step 1
Db.Execute "INSERT INTO InvoiceJoin(InvoiceID,ProductID,Propagator,GreenhouseNr,Qty) VALUES('" & txtInvoiceID & "', " & listBox1.Column(1, i) & " , " & listBox1.Column(3, i) & " , " & listBox1.Column(4, i) & " , " & listBox1.Column(5, i) & ")"
Next
For i = 0 To listBox1.ListCount - 1 Step 1
Db.Execute "Update tblTempStocks set Qty=Qty - " & listBox1.Column(4, i) & " where ProductID=" & listBox1.Column(0, i) & ""
Next
MsgBox "Successfully done", vbInformation, "Sales"
End Sub
Related
Putting together a query (with SQL statement) button that checks for duplicate combobox entries (within one submission) before they happen.
Trying to comprehend why this works:
ElseIf Me.pc_cbox1 = Me.pc_cbox2 Then
MsgBox "Duplicate Program Code Error"
But this does not:
ElseIf (Me.pc_cbox1 Or Me.pc_cbox2 Or Me.pc_cbox3 Or Me.pc_cbox4 Or Me.pc_cbox5 Or Me.pc_cbox6 Or Me.pc_cbox7 Or Me.pc_cbox8) =
(Me.pc_cbox1 Or Me.pc_cbox2 Or Me.pc_cbox3 Or Me.pc_cbox4 Or Me.pc_cbox5 Or Me.pc_cbox6 Or Me.pc_cbox7 Or Me.pc_cbox8) Then
MsgBox "Duplicate Program Code Error"
Edit #1: Thought I was onto something with this loop:( ...
For intComboBox = 1 To 8
If Controls("pc_cbox" & intComboBox).ListIndex <> intComboBox Then
If Controls("pc_cbox" & intComboBox).Value = Controls("pc_cbox" & intComboBox).Value Then
MsgBox "Duplicate Program Code Error"
End If
End If
Next intComboBox
Edit #2: #HansUp's suggestion works! I am going to dissect this loop for the next hour to better understand the dictionary concept. I am new to VBA (3rd week) and I know this code is mostly spaghetti at this point but I have been forced into learning as I go at work. Here is what I have put together as an add funding (percentages) per program without duplicates. 'Program Code' is part of the primary key for the SQL table and therefore will not accept duplicate entries. I wanted to prevent being able to submit duplicates on the form to nip this issue in the bud.
Private Sub fundAdd_Click()
Dim strSQL As String, queryName As String, qdf1 As QueryDef, dct As Object, i As Long, strValue As String
queryName = "temp6"
If QueryExists(queryName) Then
DoCmd.DeleteObject acQuery, "temp6"
End If
Set dct = CreateObject("Scripting.Dictionary")
For i = 1 To 8
strValue = Nz(Me.Controls("pc_cbox" & i).Value, "NULL")
If dct.Exists(strValue) Then
MsgBox "Duplicate Program Code Error"
Exit For
Else
dct.Add strValue, vbNullString
End If
Next
If Me.percentTotal <> 1 Then
MsgBox "Total not equal to 100%"
Else
strSQL = "INSERT INTO position_funding2(box_id, program_code, percent) VALUES ('" & fundboxid_cbox & "','" & pc_cbox1 & "','" & percent1 & "'), " & _
" ('" & fundboxid_cbox & "','" & pc_cbox2 & "','" & percent2 & "'), ('" & fundboxid_cbox & "','" & pc_cbox3 & "','" & percent3 & "'), " & _
" ('" & fundboxid_cbox & "','" & pc_cbox4 & "','" & percent4 & "'), ('" & fundboxid_cbox & "','" & pc_cbox5 & "','" & percent5 & "'), " & _
" ('" & fundboxid_cbox & "','" & pc_cbox6 & "','" & percent6 & "'), ('" & fundboxid_cbox & "','" & pc_cbox7 & "','" & percent7 & "'), " & _
" ('" & fundboxid_cbox & "','" & pc_cbox8 & "','" & percent8 & "');"
MsgBox (strSQL)
Set qdf1 = CurrentDb.CreateQueryDef("temp6")
qdf1.Connect = "ODBC;Driver=MySQL ODBC 8.0 Unicode Driver;SERVER=sv03rm;UID=*****;PWD=*****;DATABASE=pobe;PORT=3306;DFLT_BIGINT_BIND_STR=1"
qdf1.SQL = strSQL
qdf1.ReturnsRecords = False
DoCmd.OpenQuery "temp6"
Me.List271.Requery
End If
Defaults
End Sub
Use your combo box values as keys of a Dictionary. Before adding each of those combo values, use the Exists method to check whether that value was already stored in the Dictionary. If it does exist, the one you're about to add is a duplicate, so display your MsgBox notice.
You didn't provide any context about where and how you intend to do the comparison. So, for my version, I used a command button's click event.
Private Sub cmdCompare_Click()
Dim dct As Object
Dim i As Long
Dim strValue As String
Set dct = CreateObject("Scripting.Dictionary")
For i = 1 To 8
strValue = Nz(Me.Controls("pc_cbox" & i).Value, "NULL")
If dct.Exists(strValue) Then
MsgBox "Duplicate Program Code Error"
Exit For
Else
dct.Add strValue, vbNullString
End If
Next
End Sub
In access 2016 I'm trying to use an update command.I'm creating a database as my internship project as I'm unfamiliar with the coding I have been struggling a lot. I'm referring to a video by Setha Iech: https://www.youtube.com/watch?v=Ri2Y9-16AEo. When I'm using the below code an error continuously pops up
Error 3464
Private Sub cmdAdd_Click()
'when we click on button Add there are two options
'1. for insert
'2. for update
If Me.txtID.Tag & "" = "" Then
'this is for insert new
'add data to table
CurrentDb.Execute "INSERT INTO Business(ID, Project_ID, [Date_of_Enquiry], Division, Client, Description, Probability_to_win,Status, [Proposal_Submission_date], [Expected_award_date], Remarks)" & _
"VALUES ('" & Me.txtID & "','" & Me.txtProject_ID & "','" & Me.txtDate_of_Enquiry & "','" & Me.cboDivision & "','" & _
Me.txtClient & "','" & Me.txtDescription & "','" & Me.cboProbability_to_win & "','" & Me.cboStatus & "','" & Me.txtProposal_Submission_date & "','" & Me.txtExpected_award_date & "','" & Me.txtRemarks & "')"
Else
'otherwise (Tag of txtID store the ID of statement to be modified)
CurrentDb.Execute "UPDATE Business" & _
" SET ID=" & Me.txtID & _
", Project_ID='" & Me.txtProject_ID & "'" & _
", Date_of_Enquiry='" & Me.txtDate_of_Enquiry & "'" & _
", Division='" & Me.cboDivision & "'" & _
", Client='" & Me.txtClient & "'" & _
", Description='" & Me.txtDescription & "'" & _
", Probability_to_win='" & Me.cboProbability_to_win & "'" & _
", Status='" & Me.cboStatus & "'" & _
", Proposal_Submission_date='" & Me.txtProposal_Submission_date & "'" & _
", Expected_award_date='" & Me.txtExpected_award_date & "'" & _
", Remarks='" & Me.txtRemarks & "'" & _
" WHERE ID=" & Me.txtID.Tag
End If
'clear form
cmdClear_Click
'refresh data in list on form
databasesub.Form.Requery
End Sub
Thank you for your answers in advance
In Access 2010 I have tables, e.g. Employee(Pracownicy). I can update the data in the table using the subform and the update button.
Updating the data in the subform automatically generates an Outlook mail containing the data in the updated record.
I need to change font color for updated data in the mail body.
The code to update the data and generate e-mail:
Private Sub cmdUpdate2_Click()
CurrentDb.Execute "update Pracownicy" & _
" SET Identyfikator='" & Me.txtID & "'" & _
", Imie='" & Me.txtImie & "'" & _
", Nazwisko ='" & Me.txtNazwisko & "'" & _
", Wiek ='" & Me.txtWiek & "'" & _
", Data_urodzenia ='" & Me.txtData & "'" & _
", Miejsce_urodzenia ='" & Me.txtMiejsce & "'" & _
", Miejscowosc ='" & Me.txtMiejscowosc & "'" & _
", Plec ='" & Me.txtPlec & "'" & _
" where Identyfikator='" & Me.txtID & "'"
'------------------------------------SEND EMAIL----------------------
'Dim varName As Variant
'Dim strUCC As String
Dim varSubject As Variant
Dim varBody As Variant
Dim Poczta As Object
Dim MojMail As Object
On Error Resume Next
'varName = ""
varSubject = "Employer List "
varBody = "Hello" & _
"<br><br>Employer List: " & _
"<br><br><B>Identyfikator:</B> " & Me.txtID & " " & _
"<br><B>Imie:</B> " & Me.txtImie & " " & _
"<br><B>Nazwisko:</B> " & Me.txtNazwisko & " " & _
"<br><B>Wiek:</B> " & Me.txtWiek & " " & _
"<br><B>Data urodzenia:</B> " & Me.txtData & " " & _
"<br><B>Miejsce urodzenia:</B> " & Me.txtMiejsce & " " & _
"<br><B>Miejscowosc:</B> " & Me.txtMiejscowosc & " " & _
"<br><B>Plec:</B> " & Me.txtPlec & " "
Set Poczta = CreateObject("outlook.application")
Set MojMail = Poczta.createitem(0)
With MojMail
'.To =
'.BCC =
.subject = varSubject
'.ReadReceiptRequested = True
'.originatorDeliveryReportRequested = True
.htmlbody = varBody & "<br>"
.display
'.send
End With
Set Poczta = Nothing
Set MojMail = Nothing
If Err.Number <> 0 Then
MsgBox ("Atention")
End If
On Error GoTo 0
'------------------------------------------------------------------------
DoCmd.Close
MsgBox ("End Update")
End Sub
I think this becomes more of an HTML question rather than VBA. Try adding a FONT tag to the following line and see if that works for you.
"<br><br><B><font color="red">Identyfikator:</font></B> " & Me.txtID & " " & _
I just faced a problem with my code.It raises an exception.This is the code.
conn = oSubPayItemDescription.GetDbConnection()
md = New OleDbCommand("SELECT [sub_pay_item_quantity].[quantity],[sub_pay_item_unit_rate].[rate] FROM " &
"[sub_pay_item_quantity],[sub_pay_item_unit_rate] WHERE [sub_pay_item_quantity].[sub item]=[sub_pay_item_unit_rate].[sub item] AND " &
"[sub_pay_item_quantity].[sub item]='" & subItem & "' AND [sub_pay_item_quantity].[bridge type]='" & bridgeType & "' " &
"AND [sub_pay_item_quantity].[span]='" & span & "'", conn)
data_reader = cmd.ExecuteReader()
If data_reader.HasRows = True Then
Do While data_reader.Read()
payItem = CDbl(data_reader.Item("pay item"))
subpayItem = CDbl(data_reader.Item("sub pay item"))
subItem = data_reader.Item("sub item")
unit = data_reader.Item("unit")
bridgeType = data_reader.Item("bridge type")
span = (data_reader.Item("span").ToString())
quantity = CDbl(data_reader.Item("quantity"))
rate = CDbl(data_reader.Item("rate"))
RichTextBox1.AppendText(payItem & vbTab & vbTab & " " & " " & subpayItem & vbTab & vbTab & subItem & vbTab & vbTab & " " & _
unit & vbTab & vbTab & " " & " " & " " & " " & bridgeType & vbTab & vbTab & " " & span & vbTab & _
"" & vbTab & " " & quantity & vbTab & rate & vbNewLine)
Loop
Else
MsgBox("Unit rate does not exist", vbCritical, "Bridge Construction Cost Estimate")
End If
It raises the exception when it reaches the do while loop indicating at pay item.
So the specified name does not exist in the DataReader as the documentation suggests:
IndexOutOfRangeException: No column with the specified name was found
and i cannot see this column in your query. You are selecting only quantity and rate.
I have a large form with multiple functions, one of the functions is to edit a subform that houses a list of codes and other various pieces of data. When I click the edit button it auto fills the boxes with the selected data, but when I make the edits and try and save it i get the error message: RUN TIME ERROR 3075 SYNTAX ERROR (MISSING OPERATOR) IN QUERY EXPRESSION
The whole code is
Private Sub cmdAdd_Click()
'when we click on button Add there are two options
'1. For insert
'2. For Update
If Me.txt_code.Tag & "" = "" Then
'this is for insert new
'add data to table
CurrentDb.Execute "INSERT INTO KWTable(KW, Source, Code) " & _
" VALUES('" & Me.text_key & "','" & Me.combo_source & "','" & _
Me.txt_code & "')"
Else
'otherwise (Tag of txtID store the id of student to be modified)
CurrentDb.Execute "UPDATE KWTable " & _
" SET KW='" & Me.text_key & _
", Code='" & Me.txt_code & "'" & _
", Source='" & Me.combo_source & "'" & _
" WHERE KW='" & Me.text_key
End If
'clear form
cmdClear_Click
'refresh data in list on form
TableSub.Form.Requery
End Sub
And the portion that is highlighted when I try and debug the issue is.
CurrentDb.Execute "UPDATE KWTable " & _
" SET KW='" & Me.text_key & _
", Code='" & Me.txt_code & "'" & _
", Source='" & Me.combo_source & "'" & _
" WHERE KW='" & Me.text_key
Try
CurrentDb.Execute "UPDATE KWTable " & _
" SET KW='" & Me.text_key & _
"', Code='" & Me.txt_code & "'" & _
", Source='" & Me.combo_source & "'" & _
" WHERE KW='" & Me.text_key + "'"