Reputation: 741
I am attempting to take a VBA Dictionary and either:
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.
Upvotes: 0
Views: 301
Reputation: 55856
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.
Upvotes: 1