I have been trying to resolve an issue for writing the data into Access database using Excel VBA. Basically, our company has a spreadsheet that people can use to input data and save the data into Access database by clicking a button. Initially, the spreadsheet was working fine. However, after some time, several coworkers started to have issue saving the data. When they click the button, the cursor starts to turn and excel freezes/crashes (we had to force excel to close). This is very strange cause it happens randomly (my coworkers are just inputting some report data of different companies). Sometimes the data can be saved with no issue and sometimes the excel just crashes. Some coworker can input data from 5 companies but she can only successfully save 3 of them. So far, I have told them to save a copy of each company's data until this issue is resolved.
I have tried to debug and the problem seems to come from the rs.update syntax (the one shown below). Whenever VBA runs to this rs.update, it starts to crash. You can find this rs.update syntax from the actual coding I pasted below.
rs.Fields("TimeStamp") = load_time
rs.Fields("User") = current_user_name
rs.Fields("Ticker") = curr_ticker
rs.Fields("LoadID") = this_entry_ID
rs.Update
Else
ssss = 1
'rs.AddNew
Set rs = db.OpenRecordset("AIF_Summary", dbOpenTable)
rs.AddNew
rs.Fields("Ticker") = curr_ticker
rs.Fields("Initiator") = current_user_name
rs.Fields("StartDate") = Sheets("Main").Range("STARTDATE")
rs.Fields("EffectiveDate") = Sheets("Main").Range("EFFECTIVEDATE")
rs.Fields("EvaluationYear") = Sheets("Main").Range("EVALUATIONYEAR")
rs.Fields("GLJ_Frac") = Sheets("Main").Range("GLJFRAC")
rs.Fields("McDan_Frac") = Sheets("Main").Range("MCDANFRAC")
rs.Fields("Sproule_Frac") = Sheets("Main").Range("SPROULEFRAC")
rs.Fields("Other_Frac") = Sheets("Main").Range("OTHERFRAC")
rs.Fields("CustomNotes") = Sheets("Main").Range("CUSTOMNOTES")
rs.Fields("T1_CustomNotes") = Sheets("T1").Range("T1_CUSTOMNOTES")
rs.Fields("T2_CustomNotes") = Sheets("T2").Range("T2_CUSTOMNOTES")
rs.Fields("T3_CustomNotes") = Sheets("T3").Range("T3_CUSTOMNOTES")
rs.Fields("T4_CustomNotes") = Sheets("T4").Range("T4_CUSTOMNOTES")
rs.Fields("T5_CustomNotes") = Sheets("T5").Range("T5_CUSTOMNOTES")
rs.Fields("T6_CustomNotes") = Sheets("T6").Range("T6_CUSTOMNOTES")
rs.Fields("T7_CustomNotes") = Sheets("T7").Range("T7_CUSTOMNOTES")
If Len(Sheets("Main").Range("OTHER_IQRE_NAME")) > 0 And Val(Sheets("Main").Range("OTHERFRAC")) > 0 Then
rs.Fields("Other_IQRE_Name") = Sheets("Main").Range("OTHER_IQRE_NAME")
End If
rs.Fields("DataBaseFlag") = Sheets("Main").Range("DATABASEFLAG")
rs.Fields("CompanyName") = Sheets("Main").Range("CompanyName")
rs.Fields("AddedDateTime") = load_time
rs.Fields("T1_Currency") = Sheets("T1").Range("T1_Currency")
rs.Fields("T7_Currency") = Sheets("T7").Range("T7_Currency")
rs.Fields("MIC_Currency") = Sheets("MIC").Range("MIC_Currency")
rs.Fields("T1_PriceDeck") = Sheets("T1").Range("T1_PRICEDECK")
this_entry_ID = rs.Fields("ID")
rs.Update
rs.Close
Set rs = Nothing
Set rs = db.OpenRecordset("AIF_Data", dbOpenTable)
On Error GoTo -1
For v = 1 To 1354
var_value = ""
If Mid(write_vars(v, 1), 1, 2) = "T1" Then var_value = Worksheets("T1").Range(write_vars(v, 1))
If Mid(write_vars(v, 1), 1, 2) = "T2" Then var_value = Worksheets("T2").Range(write_vars(v, 1))
If Mid(write_vars(v, 1), 1, 2) = "T3" Then var_value = Worksheets("T3").Range(write_vars(v, 1))
If Mid(write_vars(v, 1), 1, 2) = "T4" Then var_value = Worksheets("T4").Range(write_vars(v, 1))
If Mid(write_vars(v, 1), 1, 2) = "T5" Then var_value = Worksheets("T5").Range(write_vars(v, 1))
If Mid(write_vars(v, 1), 1, 2) = "T6" Then var_value = Worksheets("T6").Range(write_vars(v, 1))
If Mid(write_vars(v, 1), 1, 2) = "T7" Then var_value = Worksheets("T7").Range(write_vars(v, 1))
If Len(var_value) > 0 Then
rs.AddNew
rs.Fields("VariableName") = write_vars(v, 1)
If write_vars(v, 4) = "Liquid" Then
rs.Fields("VariableValue") = var_value * liquid_unit_convert 'DB stores mbbl and mmcf as standard units
End If
If write_vars(v, 4) = "Gas" Then
rs.Fields("VariableValue") = var_value * gas_unit_convert 'DB stores mbbl and mmcf as standard units
End If
' If write_vars(v, 4) = "T1_Currency" Then
' rs.Fields("VariableValue") = var_value * currency_unit_convert 'DB stores $ as standard units
' End If
'
' If write_vars(v, 4) <> "Liquid" And write_vars(v, 4) <> "Gas" And write_vars(v, 4) <> "T1_Currency" Then
' rs.Fields("VariableValue") = var_value
' End If
If write_vars(v, 4) <> "Liquid" And write_vars(v, 4) <> "Gas" And write_vars(v, 4) <> "T1_Currency" Then
rs.Fields("VariableValue") = var_value
End If
If write_vars(v, 4) = "T1_Currency" Then
rs.Fields("VariableValue").Value = var_value * currency_unit_convert 'DB stores $ as standard units
End If
rs.Fields("TimeStamp") = load_time
rs.Fields("User") = current_user_name
rs.Fields("Ticker") = curr_ticker
rs.Fields("LoadID") = this_entry_ID
rs.Update
Else
ssss = 1
'rs.AddNew
'rs.Fields("VariableName") = write_vars(v, 1)
'rs.Fields("VariableValue") = 0
'rs.Fields("TimeStamp") = load_time
'rs.Fields("User") = current_user_name
'rs.Fields("Ticker") = curr_ticker
'rs.Fields("LoadID") = this_entry_ID
'rs.Update
End If
Next v
ADOFromExcelToAccess this_entry_ID
Sheets("Database Variables").Visible = False
Sheets("Companies").Visible = False
End Sub
Can someone share his opinion?
Thanks.
