I am attempting to take a VBA Dictionary and either:
Insert a new row into the database if it does not exist
Update the row if it does
While my current code works for this, it runs extremely slowly for the thousands of records I may need to update, and other solutions I have found on this site do not really achieve what I am after. Could anyone help me achieve this? My code so far is below:
Sub UpdateDatabase(dict As Object)
Dim Conn As Object, StrSQL As String, Rs As Object
Dim hmm As ADODB.Recordset
Set Conn = CreateObject("ADODB.Connection")
Conn.Provider = "Microsoft.ACE.OLEDB.12.0"
Conn.Open "C:\XXXX\cfrv2.accdb"
dictCount = dict.Count
counter = 0
For Each varKey In dict.Keys()
Application.StatusBar = Str(counter) & "/" & Str(dictCount)
counter = counter + 1
StrSQL = "SELECT * FROM `All SAMs Backlog` WHERE [LOCID] = '" & varKey & "'"
Set hmm = Conn.Execute(StrSQL)
If hmm.BOF And hmm.EOF Then
StrSQL = "INSERT INTO `ALL SAMs Backlog` ([SAM], [LOCID], [RTC Date], [CFR Status], [CFR Completed Date], [CFR On Hold Reason], [MDU], [ICWB Issue], [Obsolete]) VALUES (dict.Item(varKey)(0), '" & varKey & "', '20/12/2018', '" & dict.Item(varKey)(1) & "', '02/01/2019', '" & dict.Item(varKey)(2) & "' , '" & dict.Item(varKey)(3) & "' , '" &dict.Item(varKey)(4) & "' , '" & dict.Item(varKey)(5) & "')"
Conn.Execute (StrSQL)
Else
'Update the LOC in the table
StrSQL = "UPDATE `All SAMs Backlog` SET ([CFR Status] = '" & dict.Item(varKey)(1) & "', [CFR On Hold Reason] = '" & dict.Item(varKey)(2) & "', [MDU] = '" & dict.Item(varKey)(3) & "', [ICWB Issue] = '" & dict.Item(varKey)(4) & "', [Obsolete] = '" & dict.Item(varKey)(5) & "')"
Conn.Execute (StrSQL)
End If
Next
Conn.Close
End Sub
Any help is appreciated.
Either:
Write the content of the dictionary to a temp table, then run a query as described here:
Update or insert data in table
or:
Open [All SAMs Backlog] as a recordset, loop the dictionary to add or edit records as needed, then close the recordset.
Related
I am creating a userform to update student attendance details. When updating a table in MS Access via Excel userform, the data is not updated. Instead it shows 0 or -1 on attendanceStatus column and nothing in the Excuse columnthis is a picture of my ClassDate table after attempting to update for student IT01 and IT02.
My userform contains values for courseCode, subject, classDate, studentID, name, attendance status, and excuse. Therefore, I will be using the values of classDate, courseCode, and studentID to find the attendance of the student whom I want to update. This is my attempt for the Userform update button to update the attendanceStatus and Excuse column in the MS Access ClassDate table.
Private Sub CommandButton1_Click()
Dim cnt As ADODB.Connection
Dim db_path As String
Dim db_str As String
db_path = "C:\Users\Lenovo\Documents\BIT\SEM4\SAD\StudentAttendanceMonitoring\attendance1.accdb;"
Set cnt = New ADODB.Connection
db_str = "provider=Microsoft.ACE.OLEDB.12.0; data source=" & db_path
cnt.Open (db_str)
insert_str = "update Classdate set attendanceStatus = '" & cmbUpdateStatus.Value & "' and Excuse = '" & txtUpdateExcuse.Value & "' where classDate = '" & cmbUpdateDate.Value & "' and courseCode = '" & cmbUpdateCourseCode.Value & "' and studentID = '" & cmbUpdateStudentID.Value & "'"
Debug.Print insert_str
cnt.Execute (insert_str)
MsgBox "Updated sucessfully", vbInformation
Set cnt = Nothing
End Sub
Should be a comma to separate field update expressions, not and.
insert_str = "update Classdate set attendanceStatus = '" & cmbUpdateStatus.Value & _
"', Excuse = '" & txtUpdateExcuse.Value & _
"' where classDate = '" & cmbUpdateDate.Value & _
"' and courseCode = '" & cmbUpdateCourseCode.Value & _
"' and studentID = '" & cmbUpdateStudentID.Value & "'"
Trying to update table in ms Access using VBA but getting failed , used multiple option but table not getting updated
Dim bod As Date
Dim assets As String
Dim emname As String
Dim ecode As String
Dim Astatus As String
Astatus = "SOLD"
msaved = True
DoCmd.SetWarnings False
bod = Me.datetime.Caption
price1k = Me.cmbox1_1AID.Value
emname = Me.empname.Value
ecod = Nz(Me.code.Value, 0)
//tried using this but not getting updated no error
DoCmd.RunSQL "UPDATE [Asset E7450 List] SET Code = '" & ecod & "',[Date & Time] ='" & bod & "' ,Status ='" & Astatus & "',[Sold To] ='" & empname & "', where Asset-ID ='" & price1k & "'"
// Tried using this no update no error
CurrentDb.Execute "UPDATE [Asset E7450 List] SET Code = '" & ecod & "',[Date & Time] ='" & bod & "' ,Status ='" & Astatus & "',[Sold To] ='" & empname & "', where Asset-ID ='" & price1k & "'"
// Tried this method no data update no error
Dim strSQL As String
strSQL = "UPDATE [Asset E7450 List] SET Code = '" & ecod & "',[Date & Time] ='" & bod & "' ,Status ='" & Astatus & "',[Sold To] ='" & empname & "', where Asset-ID ='" & price1k & "'"
DoCmd.RunSQL strSQL
MsgBox " Booking Request Accepted ", vbInformation
If [Date & Time] is a date/time type field, use # delimiter instead of '. If field is a number type, don't use any delimiter.
Remove the comma in front of WHERE clause.
Need [ ] around Asset-ID field name because of the hyphen.
Advise not to use spaces nor punctuation/special characters in naming convention.
I am trying to move all of the cords from one recordset to another and was wondering if a specific method could do this. Here is my code.
Dim maxDate As Variant
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim destin As DAO.Recordset
maxDate = DMax("[Eff Date]", "400_CF_BREAK_LOG")
Set db = CurrentDb
Set rs = db.OpenRecordset("860_APPEND_DIFFERENCES") 'myTable is a MS-Access table created previously
Set destin = db.OpenRecordset("400_CF_BREAK_LOG")
'populate the table
rs.MoveFirst
Do While Not rs.EOF
If (rs![Eff Date] > maxDate) Then
destin.
Debug.Print (rs!myField) 'myField is a field name in table myTable
rs.MoveNext
Loop
I am caught at the destin. <---- Add the whole record here.
EDIT. The chosen answer while correct, might not account for a differing number of fields between tables. I find myself using this set-up for adding three different recordsets. Taken from Insert Complete RecordSet to another table in other database MS Access
maxDate = DMax("[Eff Date]", "400_CF_BREAK_LOG")
Set db = CurrentDb
Set rs = db.OpenRecordset("mytable") 'myTable is a MS-Access table created previously
'populate the table
rs.MoveFirst
Do While Not rs.EOF
If (rs![Eff Date] > maxDate) Then
sqlinsert = "INSERT INTO 400_CF_BREAK_LOG (Eff Date, PrimarySecurity ID Number, CUSIP(Aladdin ID), IsrName, Asset Type, Metlife Port Code, Business Unit, Principal Difference, Total PAM Principal, Total Aladdin Principal,Income Difference, Total PAM Interest,Total Aladdin Interest,Total CF Difference,Total PAM CF,PAM Coupon)" & _
" VALUES ('" & rs("Eff Date") & "', '" & rs("PrimarySecurity ID Number") & "', '" & rs("CUSIP(Aladdin ID)") & "', '" & rs("IsrName") & "', '" & rs("Asset Type") & "', '" & rs("Metlife Port Code") & "', '" & rs("Business Unit") & "', '" & rs("Principal Difference") & "', '" & rs("Total PAM Principal") & "', '" & rs("Total Aladdin Principal") & "', & '" & rs("Income Difference") & "', '" & rs("Total PAM Interest") & "', '" & rs("Total Aladdin Interest") & "', '" & rs("Total CF Difference") & "', '" & rs("Total PAM CF") & "', '" & rs("PAM Coupon") & "')"
DoCmd.RunSQL (sqlinsert)
rs.MoveNext
Loop
You can modify this to your need (here source and target is the same table):
Public Sub CopyRecords()
Dim rstSource As DAO.Recordset
Dim rstInsert As DAO.Recordset
Dim fld As DAO.Field
Dim strSQL As String
Dim lngLoop As Long
Dim lngCount As Long
strSQL = "SELECT * FROM tblStatus WHERE Location = '" & _
"DEFx" & "' Order by Total"
Set rstInsert = CurrentDb.OpenRecordset(strSQL)
Set rstSource = rstInsert.Clone
With rstSource
lngCount = .RecordCount
For lngLoop = 1 To lngCount
With rstInsert
.AddNew
For Each fld In rstSource.Fields
With fld
If .Attributes And dbAutoIncrField Then
' Skip Autonumber or GUID field.
ElseIf .Name = "Total" Then
' Insert default job code.
' datNow = Now
rstInsert.Fields(.Name).Value = 0
ElseIf .Name = "PROCESSED_IND" Then
rstInsert.Fields(.Name).Value = vbNullString
Else
' Copy field content.
rstInsert.Fields(.Name).Value = .Value
End If
End With
Next
' Insert fields not existing in source table
rstInsert!SomeField.Value = SomeValue
rstInsert!SomeOtherField.Value = SomeOtherValue
rstInsert!YetAField.Value = ThirdValue
.Update
End With
.MoveNext
Next
rstInsert.Close
.Close
End With
Set rstInsert = Nothing
Set rstSource = Nothing
End Sub
Can someone take a look a the stSQL string and help me fix the syntax error I am getting associated with the UPDATE statement?
Run-time error '-2147217900 (8004e14)': Syntax error in UPDATE statement.
I have a rudimentary understanding of SQL and don't seem to understand where I have gone wrong.
I want to update the fields of Table 1 if the FileName UserForm value matches a FileName field in the Access Db.
Thanks
Public Sub UpdateDatabaseEntry()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim stDB As String, stSQL As String, stProvider As String
Dim FileName As String
Dim Nickname As String
Dim RecipientName As String
Dim RecipientRelationship As String
Dim Summary As String
Dim Noteworthy As String
Dim PreparedBy As String
FileName = UserForm1.FileNameTextBox.Text
Nickname = UserForm1.NicknameTextBox.Text
RecipientName = UserForm1.RecipientNameTextBox.Text
RecipientRelationship = UserForm1.RecipientRelationshipComboBox.Text
Summary = UserForm1.SummaryTextBox.Text
Noteworthy = UserForm1.NoteworthyCheckBox.Value
PreparedBy = UserForm1.PreparedByTextBox.Text
stDB = "Data Source= E:\MyDb.accdb"
stProvider = "Microsoft.ACE.OLEDB.12.0"
//Opening connection to database
With cn
.ConnectionString = stDB
.Provider = stProvider
.Open
End With
//SQL Statement telling database what to do
stSQL = "UPDATE Table1" & _
"SET Nickname= '" & Nickname & "', RecipientName= '" & RecipientName & "', " & _
"RecipientRelationship= '" & RecipientRelationship & "', Summary= '" & Summary & "', " & _
"Noteworthy= '" & Noteworthy & "', PreparedBy= '" & PreparedBy & "', " & _
"WHERE FileName= '" & FileName & "'"
cn.Execute stSQL
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
At least one problem is caused by lack of spaces in the query. So your query started UPDATE Table1set.
stSQL = "UPDATE Table1 " & _
"SET Nickname= '" & Nickname & "', RecipientName= '" & RecipientName & "', " & _
"RecipientRelationship= '" & RecipientRelationship & "', Summary= '" & Summary & "', " & _
"Noteworthy= '" & Noteworthy & "', PreparedBy= '" & PreparedBy & "'" & _
"WHERE FileName= '" & FileName & "'"
If this doesn't fix the problem. Then edit your question with the value of stSQL after the variable substitution.
EDIT:
As TS points out, another problem is the , before the where (fixed above).
Currently I have the update code for insert record to tbl_order. Now that I implement the inventory section. I need the system can subtract qty from inventory once the order had been made.
I'm thinking about INSERT (Subtract (od_qty-tbl_inventory.inv_qty)) but I don't know how SQL statement gonna be in this case. So could you please help. Thank you
Below is my current update code for INSERT data to tbl_order.
<%
dim od_total, cal_total, od_qty
cust_id = request.querystring("cust_id")
bill_id = request.querystring("bill_id")
pd_id = request.querystring("pd_id")
od_price = request.querystring("od_price")
od_qty = request.querystring("od_qty")
od_qty_unit = request.querystring("od_qty_unit")
date_current = date
od_total = od_price * od_qty
Dim conn ' ADO connection
Dim rstSimple ' ADO recordset
Dim strDBPath ' path to our Access database (*.mdb) file
Dim bill_total
set conn=Server.CreateObject("ADODB.Connection")
conn.Provider="Microsoft.Jet.OLEDB.4.0"
conn.Open(Server.Mappath("../database/tkp.mdb"))
set rs=Server.CreateObject("ADODB.recordset")
' Next, the script inserts the form inputs retrieved from the querystring into the database table:
sql="INSERT INTO tbl_order (cust_id,bill_id,pd_id,od_price,od_qty,od_qty_unit,od_total)"
sql=sql & " VALUES "
sql=sql & "(" & cust_id & ","
sql=sql & "'" & bill_id & "',"
sql=sql & "'" & pd_id & "',"
sql=sql & "" & od_price & ","
sql=sql & "" & od_qty & ","
sql=sql & "'" & od_qty_unit & "',"
sql=sql & "" & od_total & ")"
'response.write sql
on error resume next
conn.Execute sql
if err<>0 then
Response.Write("No update permissions!") 'ae_name field is primary key so new record not inserted if name pre-exists in table
else
'Response.Write("<h3> Record added</h3>")
end if
rstSimple.Close
Set rstSimple = Nothing
conn.Close
Set conn = Nothing
%>
You need to run an update query on your inventory table that subtracts the order quantity from the current inventory amount. Something like this:
sql = "UPDATE tbl_inventory SET inv_qty = inv_qty - " & od_qty & " WHERE pd_id = " & pd_id
You will be able to solve your problem with transaction handling
conn.BeginTrans
'—Run Your Statements Here
conn.Execute sql1
conn.Execute sql2
conn.CommitTrans
Refer this for more info : http://classical-asp.blogspot.com/2010/08/transaction.html
EDIT : make sure inv_date column is a datetime column
sql1 = "UPDATE tbl_inventory SET inv_qty_act = inv_qty_act - " & od_qty & ", inv_date = now() WHERE pd_id = '" & pd_id & "'"