Unable save data using sqlserverce - vb.net

I'm trying to save data using local database (SQLServerCe) with below code
Private Sub save_setup()
Dim msg As String
Try
If setupupdate = True Then
sql = "UPDATE connection_setup SET datasource_name = '" & t_hostname.Text & "'" & _
", database_name = '" & t_dbname.Text & "', username = '" & t_uid.Text & "'" & _
", password = '" & t_passwd.Text & "'"
msg = "Updated"
Else
sql = "INSERT INTO connection_setup(datasource_name, database_name, username, password)" & _
" VALUES('" & t_hostname.Text & "', '" & t_dbname.Text & "','" & t_uid.Text & "'" & _
" , '" & t_passwd.Text & "') "
msg = "Inserted"
End If
If conCe.State = ConnectionState.Closed Then
conCe.Open()
End If
comCe = New SqlCeCommand(sql, conCe)
comCe.ExecuteNonQuery()
comCe.Dispose()
conCe.Close()
MsgBox(msg, MsgBoxStyle.Information, "Connection Setup")
Catch
MsgBox(Err.Description, MsgBoxStyle.Information, "Connection Setup")
End Try
End Sub
When i push button save, which is run code above, no issue on the process but the data is not saved.
I'm using Visual Studio 2010 with .NET Framework 4.
Any idea what the cause and its solution?
FYI:
If I ran insert/update data by SQL query, the data can be saved.

Your data is saved in a copy of the database in the bin/debug folder. Simplest fix is to specify a full path in the connection string during development.

Related

OleDBException Reading Excel File - Reader not being closed, but where?

I apologize in advance if this has been answered before. I searched for it but could not find anything explaining this particular issue.
I'm getting the OleDb exception 0x80004005 - Cannot open any more tables while reading a large Excel spreadsheet. It parses around 2000 records correctly than breaks.
I searched for this error, which is related to a limit of 2048 tables being open at a given time. I cannot see where my code is wrong, and I think it is, but I need a fresh pair of eyes looking at me to point me out what I'm missing.
This is the code - As you can see, I am closing the reader ReaderExcelProgramsColumn
What am I not seeing?
If strSpreadSheetFullPathLowCase.Contains(".xlsx") Then
strConnectionStringExtendedParameters = ";Extended Properties=""Excel 12.0 Xml;HDR=YES;IMEX=1;Mode=Read;Readonly=True"";"
ElseIf strSpreadSheetFullPathLowCase.Contains(".xlsm") Then
strConnectionStringExtendedParameters = ";Extended Properties=""Excel 12.0 Macro;HDR=YES;IMEX=1;Mode=Read;Readonly=True"";"
End If
Dim intColumStartLocator As Integer = 0
Dim strConnectionStringExcel = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & txtFilePathOpenExcel.Text & strConnectionStringExtendedParameters
Dim strProgramID As String = Nothing
Dim strMachinePrefix As String = Nothing
Dim strProgramFileExtensionFromExcel As String = Nothing
Dim strLastFileName As String = Nothing
Dim strLastProgramID As String = Nothing
Dim strFullFilePath As String = Nothing
Dim sqlExcelConnection As OleDbConnection = Nothing
Try
'/////////////////////////////////////////////
'// Open the connection with the Excel File //
'/////////////////////////////////////////////
lblStatus.Text = "Opening connection with MS-Excel..."
Application.DoEvents()
sqlExcelConnection = New OleDbConnection(strConnectionStringExcel)
sqlExcelConnection.Open()
Catch ex As Exception
If (sqlExcelConnection.State = ConnectionState.Open) Then
sqlExcelConnection.Dispose()
End If
ErrorToReadFromMSExcel(ex.ToString, System.Reflection.MethodInfo.GetCurrentMethod.ToString, True)
Exit Sub
End Try
Try
Dim strProgramsQuery As String = "SELECT" & vbNewLine &
"[" & cboxExcelCIMCODBFieldProgram.Text & "]" & vbNewLine &
"FROM [" & cboxExcelTabName.Text & "$]"
Dim Query As String = String.Empty
Dim sqlSelectColumnsExcelPrograms As New OleDbCommand(strProgramsQuery, sqlExcelConnection)
Dim ReaderExcelProgramsColumn As OleDbDataReader = sqlSelectColumnsExcelPrograms.ExecuteReader
Do While ReaderExcelProgramsColumn.Read()
If ReaderExcelProgramsColumn.HasRows Then
strProgramID = Trim(UCase(ReaderExcelProgramsColumn.GetValue(0).ToString))
Dim strQuery As String = "SELECT" & vbNewLine &
"hdrfullprefix" & vbNewLine &
"FROM " & strCustomNameForHeaderSettingsTable & " AS slb" & vbNewLine &
"INNER JOIN " & strTableMchGroups & " AS mg" & vbNewLine &
"WHERE mg." & strMchGroupID & " = slb.machidncbase" & vbNewLine &
"AND mg." & strMchGroup & " = '" & cboxCIMCOMachineToMigrate.Text & "'" & vbNewLine &
"ORDER BY id DESC" & vbNewLine &
"LIMIT 1"
strMachinePrefix = RunBasicQueryReturnIsStringOnNCBase(strNCBaseConnectionString, strQuery)
If strProgramID <> String.Empty Then
lblStatus.Text = "Extracting program '" & strProgramID & "' from the spreadsheet..."
Application.DoEvents()
arrProgramsInTheSpreadSheet.Add(strProgramID)
arrProgramsPrefixes.Add(strMachinePrefix)
End If
If arrProgramsInTheSpreadSheet.Count = 0 Then
MessageBox.Show(Me, "Could not find programs in the spreadsheet in the column '" & cboxExcelCIMCODBFieldProgram.Text & "', tab '" & cboxExcelTabName.SelectedItem.ToString & "' of the selected spreadsheet!" _
& vbNewLine & vbNewLine & "Please check if the column name selected for program extraction is correct in the spreadsheet and try again.", "Could not find programs in the selected spreadsheet!", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
Else
ReaderExcelProgramsColumn.Close()
MessageBox.Show(Me, "Could not find programs in the spreadsheet in the column '" & cboxExcelCIMCODBFieldProgram.Text & "', tab '" & cboxExcelTabName.SelectedItem.ToString & "' of the selected spreadsheet!" _
& vbNewLine & vbNewLine & "Please check if the column name selected for program extraction is correct in the spreadsheet and try again.", "Could not find programs in the selected spreadsheet!", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
strLastProgramID = strProgramID
Application.DoEvents()
Loop
ReaderExcelProgramsColumn.Close()
sqlSelectColumnsExcelPrograms.Dispose()
'Close connection to release memory
ReaderExcelProgramsColumn.Close()
sqlSelectColumnsExcelPrograms.Dispose()
sqlExcelConnection.Dispose()
'Open a new connection
sqlExcelConnection = New OleDbConnection(strConnectionStringExcel)
sqlExcelConnection.Open()
lblStatus.Text = "Starting data extraction... Please wait..."
Application.DoEvents()
'*** Sort the array ***
arrProgramsInTheSpreadSheet.Sort()
'*** Capture Program Extensions ***
For i As Integer = 0 To arrProgramsInTheSpreadSheet.Count - 1
strProgramsQuery = "SELECT TOP 1 [" & strProgramFileExtensionNoPunctuation & "] FROM [" & cboxExcelTabName.Text & "$] WHERE [" & cboxExcelCIMCODBFieldProgram.Text & "] = '" & arrProgramsInTheSpreadSheet.Item(i) & "'"
sqlSelectColumnsExcelPrograms = New OleDbCommand(strProgramsQuery, sqlExcelConnection)
ReaderExcelProgramsColumn = sqlSelectColumnsExcelPrograms.ExecuteReader
Do While ReaderExcelProgramsColumn.Read()
'*****************************************************************************
'** The exception 0x80004005 - Cannot open any more tables occurs somewhere **
'** here, even after I closed the connection between the loops. **
'*****************************************************************************
If ReaderExcelProgramsColumn.HasRows Then
strLastProgramID = arrProgramsInTheSpreadSheet.Item(i)
lblStatus.Text = "Extracting the extension of the program '" & arrProgramsInTheSpreadSheet.Item(i) & "' from the spreadsheet..."
Application.DoEvents()
strProgramFileExtensionFromExcel = Trim(UCase(ReaderExcelProgramsColumn.GetValue(0).ToString))
tupleProgramsAndExtensions.Add((arrProgramsInTheSpreadSheet.Item(i), strProgramFileExtensionFromExcel))
Else
ReaderExcelProgramsColumn.Close()
MessageBox.Show(Me, "HeaderPuncher could not find programs in the spreadsheet in the column '" & cboxExcelCIMCODBFieldProgram.Text & "', tab '" & cboxExcelTabName.SelectedItem.ToString & "' of the selected spreadsheet!" _
& vbNewLine & vbNewLine & "Please check if the column name selected for program extraction is correct in the spreadsheet and try again.", "Could not find programs in the selected spreadsheet!", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Exit Sub
End If
Loop
Next
ReaderExcelProgramsColumn.Close()
sqlSelectColumnsExcelPrograms.Dispose()
sqlExcelConnection.Dispose()
Thanks!
The answer is what some people mentioned in the comments: The usage of Using / End Using instead of the archaic approach I was using.
Many thanks, everyone!

Syntax error in string in query expression in shortssize = S

Im updating an entry in MS Access using this code but it always returns an error. I dont know which part to correct. Please help me i cant seem to find which part is the error
Private Sub SaveChanges()
con.ConnectionString = OpenDBConnection()
con.Open()
Dim sql As String = "Update [JobOrderProd] set [CustomerOrderNumber] =
'" & CustomerOrderNumtxtbox.Text & "', [ItemNumber] = '" &
ItemNumbertxtbox.Text & "', [JerseyName] = '" &
JerseyNametxtbox.Text & "', [JerseyNumber] = '"`
& JerseyNumbertxtbox.Text & "', [JerseySize] = '" &
JerseySizetxtbox.Text & "',
[ShortsSize] = '" & ShortsSizetxtbox.Text
Dim cmd As New OleDbCommand(sql, con)`enter code here`
cmd.ExecuteNonQuery()`enter code here`
con.Close()
MsgBox("Entry for JO Production has been updated.")
ClearForm()
End Sub
I think you missed the single inverted comma in the end. add this to the end & "'"
JerseySizetxtbox.Text & "',
[ShortsSize] = '" & ShortsSizetxtbox.Text & "'"

Access won't insert a new record into my table if it already contains a record

I posted about this last week, but my wedding was at the end of the week, so I've been away for the past 5 days, so I'm trying again to see if I can get some help.
A lot of people have asked me why I'm not using a bound form, I tried that and couldn't get it to do what I wanted. I am new to Access and VBA in general, so the extent of my knowledge is following YouTube tutorials, but by all means if someone can walk me through how to create the bound form and everything, I'll take your advice.
Essentially I have a table with the data and then I want a form that has a text box for each field in the table with a subtable of the main table incorporated into the form. The user fills in the text boxes with the information and then either adds it to the table or they can click on a record and edit it or delete it with the corresponding buttons on the form.
I was having some issues with some syntax and recently fixed that today, so now I'm finally fine tuning stuff on my form. The only issue I'm having now is that if there is already a record in the table, the form won't insert a new record once I click the add button. I fill the text boxes in and click the 'Add' button and the form refreshes like the add command worked, but then the new record doesn't show up in the table. However if I go back to the table and delete any record that is already in the table and then go back to the form and fill the boxes in again and click the 'Add' button, then a new record is inserted into the form.
I created a database before the one I'm currently working on and it works fine. It is very similar to the database that I'm working on now, so I just copied it and then renamed the fields and text boxes and everything to match the information that this database will be handling.
Any ideas what's going on here and how I could fix?
Here's a link to some screenshots of the database: https://imgur.com/a/QvCY2
Here's my code:
Option Compare Database
Private Sub cmdAdd_Click()
'when we click on button Add there are two options
'1. for insert
'2. for update
If Me.txtICN.Tag & "" = "" Then
'this is for insert new
'add data to table
CurrentDb.Execute "INSERT INTO tblInventory(ICN, manu, model, serial, descr, dateRec, dateRem, dispo, flgDispo, project, AMCA, UL, comments) " & _
" VALUES(" & Me.txtICN & ", '" & Me.txtManu & "', '" & Me.txtModel & "', '" & Me.txtSerial & "', '" & Me.txtDescr & "', '" & Me.txtDateRec & "', '" & Me.txtDateRem & "', '" & Me.txtDispo & "', '" & Me.chkFlg & "', '" & Me.txtProject & "', '" & Me.txtAMCA & "', '" & Me.txtUL & "', '" & Me.txtComments & "')"
Else
'otherwise (Tag of txtICN stores the ICN of item to be modified)
CurrentDb.Execute "UPDATE tblInventory " & _
" SET ICN = " & Me.txtICN & _
", manu = '" & Me.txtManu & "'" & _
", model = '" & Me.txtModel & "'" & _
", serial = '" & Me.txtSerial & "'" & _
", descr = '" & Me.txtDescr & "'" & _
", dateRec = '" & Me.txtDateRec & "'" & _
", dateRem = '" & Me.txtDateRem & "'" & _
", dispo = '" & Me.txtDispo & "'" & _
", flgDispo = '" & Me.chkFlg & "'" & _
", project = '" & Me.txtProject & "'" & _
", AMCA = '" & Me.txtAMCA & "'" & _
", UL = '" & Me.txtUL & "'" & _
", comments = '" & Me.txtComments & "'" & _
" WHERE ICN = " & Me.txtICN.Tag
End If
'clear form
cmdClear_Click
'refresh data in list on form
frmInventorySub.Form.Requery
End Sub
Private Sub cmdClear_Click()
Me.txtICN = ""
Me.txtManu = ""
Me.txtModel = ""
Me.txtSerial = ""
Me.txtDescr = ""
Me.txtDateRec = ""
Me.txtDateRem = ""
Me.txtDispo = ""
Me.chkFlg = ""
Me.txtProject = ""
Me.txtAMCA = ""
Me.txtUL = ""
Me.txtComments = ""
'focus on ID text box
Me.txtICN.SetFocus
'set button edit to enable
Me.cmdEdit.Enabled = True
'change caption of button add to Add
Me.cmdAdd.Caption = "Add"
'clear tag on txtICN for reset new
Me.txtICN.Tag = ""
End Sub
Private Sub cmdClose_Click()
DoCmd.Close
End Sub
Private Sub cmdDelete_Click()
'delete record
'check existing selected record
If Not (Me.frmInventorySub.Form.Recordset.EOF And Me.frmInventorySub.Form.Recordset.BOF) Then
'confirm delete
If MsgBox("Are you sure you want to delete this item?", vbYesNo) = vbYes Then
'delete now
CurrentDb.Execute "DELETE FROM tblInventory " & _
"WHERE ICN =" & Me.frmInventorySub.Form.Recordset.Fields("ICN")
'refresh data in list
Me.frmInventorySub.Form.Requery
End If
End If
End Sub
Private Sub cmdEdit_Click()
'check whether there exists data in list
If Not (Me.frmInventorySub.Form.Recordset.EOF And Me.frmInventorySub.Form.Recordset.BOF) Then
'get data to text box control
With Me.frmInventorySub.Form.Recordset
Me.txtICN = .Fields("ICN")
Me.txtManu = .Fields("manu")
Me.txtModel = .Fields("model")
Me.txtSerial = .Fields("serial")
Me.txtDescr = .Fields("descr")
Me.txtDateRec = .Fields("dateRec")
Me.txtDateRem = .Fields("dateRem")
Me.txtDispo = .Fields("dispo")
Me.chkFlg = .Fields("flgDispo")
Me.txtProject = .Fields("project")
Me.txtAMCA = .Fields("AMCA")
Me.txtUL = .Fields("UL")
Me.txtComments = .Fields("comments")
'store id of item in Tag of txtICN in case ICN is modified
Me.txtICN.Tag = .Fields("ICN")
'change caption of button add to Update
Me.cmdAdd.Caption = "Update"
'disable button edit
Me.cmdEdit.Enabled = False
End With
End If
End Sub

Add Error "3134" Syntax error in INSERT INTO statement - Update and Delete error '3061' Too few parameters

I have limited experience with Access. I followed some YouTube tutorials and made a functioning DB a couple of months ago.
I adapted the first DB, which essentially is changing the field names in the table in the Access file.
I can't get the new DB to function. I have a form with a subtable of the main table and it has a few text fields to fill in with the information to input. Then it has a few buttons to the side that either Add to the table, Delete from the table, Clear the text fields, Close the form, Edit a selected field, and then the Add button changes to Update after you Edit a field so that you can click Update to update the selected field after you've made changes to it.
All of this works in my first DB and in theory it should work exactly the same after changing the field names in the new DB and the corresponding txt field names and so on. I am having a tough time getting it to work for Add, Update, or Delete.
The error on the Add is Run time error "3134" Syntax error in INSERT INTO statement.
The Update and Delete error is run time error '3061' Too few parameters. expected 1.
The Clear works, as well as the Close and Edit.
Here is the code:
Option Compare Database
Private Sub cmdAdd_Click()
'when we click on button Add there are two options
'1. for insert
'2. for update
If Me.txtICN.Tag & "" = "" Then
'this is for insert new
'add data to table
CurrentDb.Execute "INSERT INTO tblInventory(ICN, manu, modelNum, serialNum, descr, dateRec, projectNum, dispo, flgDispo, dateRemoved, comments)" & _
" VALUES(" & Me.txtICN & ", '" & Me.txtManu & "', '" & Me.txtModel & "', '" & Me.txtSerial & "', '" & Me.txtDescrip & "', '" & Me.txtDateRec & "', '" & Me.txtProjectNum & "', '" & Me.txtDispo & "', '" & Me.chkFlag & "', '" & Me.txtDateRemoved & "', '" & Me.txtComments & "')"
Else
'otherwise (Tag of txtICN store the Lab Inventory Control Number to be modified)
CurrentDb.Execute "UPDATE tblInventory " & _
" SET ICN = " & Me.txtICN & _
", manu = '" & Me.txtManu & "'" & _
", modelNum = '" & Me.txtModel & "'" & _
", serialNum = '" & Me.txtSerial & "'" & _
", descr = '" & Me.txtDescrip & "'" & _
", dateRec = '" & Me.txtDateRec & "'" & _
", projectNum = '" & Me.txtProjectNum & "'" & _
", dispo = '" & Me.txtDispo & "'" & _
", flgDispo = '" & Me.chkFlag & "'" & _
", dateRemoved = '" & Me.txtDateRemoved & "'" & _
", comments = '" & Me.txtComments & "'" & _
" WHERE ICN = " & Me.txtICN.Tag
End If
'clear form
cmdClear_Click
'refresh data in list on form
tblInventorySub.Form.Requery
End Sub
Private Sub cmdClear_Click()
Me.txtICN = ""
Me.txtManu = ""
Me.txtModel = ""
Me.txtSerial = ""
Me.txtDescrip = ""
Me.txtDateRec = ""
Me.txtProjectNum = ""
Me.txtDispo = ""
Me.chkFlag = ""
Me.txtDateRemoved = ""
Me.txtComments = ""
'focus on ICN text box
Me.txtICN.SetFocus
'set button edit to enable
Me.cmdEdit.Enabled = True
'change caption of button add to Add
Me.cmdAdd.Caption = "Add"
'clear tag on txtICN for reset new
Me.txtICN.Tag = ""
End Sub
Private Sub cmdClose_Click()
DoCmd.Close
End Sub
Private Sub cmdDelete_Click()
'delete record
'check existing selected record
If Not (Me.tblInventorySub.Form.Recordset.EOF And Me.tblInventorySub.Form.Recordset.BOF) Then
'confirm delete
If MsgBox("Are you sure you want to delete this inventory entry?", vbYesNo) = vbYes Then
'delete now
CurrentDb.Execute "DELETE FROM tblInventory " & _
"WHERE ICN = " & Me.tblInventorySub.Form.Recordset.Fields("ICN")
'refresh data in list
Me.tblInventorySub.Form.Requery
End If
End If
End Sub
Private Sub cmdEdit_Click()
'check whether there exists data in list
If Not (Me.tblInventorySub.Form.Recordset.EOF And Me.tblInventorySub.Form.Recordset.BOF) Then
'get data to text box control
With Me.tblInventorySub.Form.Recordset
Me.txtICN = .Fields("ICN")
Me.txtManu = .Fields("manu")
Me.txtModel = .Fields("modelNum")
Me.txtSerial = .Fields("serialNum")
Me.txtDescrip = .Fields("descr")
Me.txtDateRec = .Fields("dateRec")
Me.txtProjectNum = .Fields("projectNum")
Me.txtDispo = .Fields("dispo")
Me.chkFlag = .Fields("flgDispo")
Me.txtDateRemoved = .Fields("dateRemoved")
Me.txtComments = .Fields("comments")
'store ICN in Tag of txtICN in case id is modified
Me.txtICN.Tag = .Fields("ICN")
'change caption of button add to Update
Me.cmdAdd.Caption = "Update"
'disable button edit
Me.cmdEdit.Enabled = False
End With
End If
End Sub
What data types are dateRec, flgDispo, dateRemoved? Values for DateTime fields must be delimited with # not '. Is flgDispo a Yes/No type? If so, this is numeric type field and number values do not have delimiters.
Why delete records? Do you really want to lose history? Why not just flag as 'Archived' or 'Inactive'? Deleting records should be a rare event.
I always give subform containers a name different from the object they hold, like ctrInventory:
CurrentDb.Execute "DELETE FROM tblInventory WHERE ICN = " & Me.ctrInventory!ICN
First, all your date expressions must be formatted like this:
", dateRec = #" & Format(Me.txtDateRec.Value, "yyyy\/mm\/dd") & "#" & _
or you could apply my CSql function to handle all this:
Convert a value of any type to its string representation
However, it appears that you could make life much easier for yourself by simply binding your form to the table - and then remove all of this code as the form will handle edit, insert, and delete automatically.

Stoping Macro if Connection is Lost

I have a series of codes that run when designated, the first is a connection check. If it is successful then it allows the code to continue, if not it stops it altogether. I am worried however about what happens when the connection is lost after this process. There is data on a local table that is uploaded to our SQL server during this process, if the connection terminates mid download it looks like sometimes the data is still transferred but not if it happens right away.
The second part of the code, deletes all the local tables contents which contain employee information, then downloads the new data so if there were any updates the most recent information is provided.
I am trying to figure out if there is a method or code that can be implemented to tell the query to stop running as soon as connection is lost, or if there is a way to undo it if it happens.
Or would it be a good idea to combine the connection code with the upload and delete codes so it runs every time before it initiates a process?
The connection code that runs at the beginning is:
Public Function StartUp()
Dim cnn As ADODB.Connection
Dim localrst As New ADODB.Recordset
Dim remoterst As New ADODB.Recordset
On Error Resume Next
Set cnn = New ADODB.Connection
cnn.Open "Provider=PRO; Data Source=SOURCE; Initial Catalog=CAT;" _
& "User Id=ID; Password=PW;"
If cnn.State = adStateOpen Then
MsgBox ("You have an established connection with the L&TD SQL Server Database and the CDData table has been uploaded to the server.")
Else
MsgBox ("Cannot connect to SQL Server. Data will be stored locally to CDData Table until application is opened again with an established connection.")
End
End If
On Error GoTo 0
' MsgBox ("Please wait while the database is updating, this may take a moment.")
End Function
As you can see, I placed an END before the END IF so if there is no connection it just ends altogether.
The UPLOAD code is
Public Function Update()
Dim cdb As DAO.Database, qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim err As DAO.Error
' Const DestinationTableName = "AC_CDData"
Const ConnectionString = _
"ODBC;" & _
"Driver={SQL Server Native Client 10.0};" & _
"Server=SERV;" & _
"Database=DB;" & _
"UID=ID;" & _
"PWD=PWD;"
Set cdb = CurrentDb
Set qdf = cdb.CreateQueryDef("")
Set rs = CurrentDb.OpenRecordset("CDData", dbOpenTable)
qdf.Connect = ConnectionString
Do While Not rs.EOF
qdf.SQL = "INSERT INTO AC_CDData_1(EmployeeID, EmployeeName, Region, District, Function1, Gender, EEOC, Division, Center, MeetingReadinessLevel, ManagerReadinessLevel, EmployeeFeedback, DevelopmentForEmployee1, DevelopmentForEmployee2, DevelopmentForEmployee3, DevelopmentForEmployee4, DevelopmentForEmployee5, Justification, Notes, Changed, JobGroupCode, JobDesc, JobGroup) " & _
"Values (" & _
"'" & rs!EmployeeID & "', " & _
"'" & rs!EmployeeName & "', " & _
"'" & rs!Region & "', " & _
"'" & rs!District & "', " & _
"'" & rs!Function1 & "', " & _
"'" & rs!Gender & "', " & _
"'" & rs!EEOC & "', " & _
"'" & rs!Division & "', " & _
"'" & rs!Center & "', " & _
"'" & rs!ManagerReadinessLevel & "', " & _
"'" & rs!MeetingReadinessLevel & "', " & _
"'" & rs!EmployeeFeedback & "', " & _
"'" & rs!DevelopmentForEmployee1 & "', " & _
"'" & rs!DevelopmentForEmployee2 & "', " & _
"'" & rs!DevelopmentForEmployee3 & "', " & _
"'" & rs!DevelopmentForEmployee4 & "', " & _
"'" & rs!DevelopmentForEmployee5 & "', " & _
"'" & rs!Justification & "', " & _
"'" & rs!Notes & "', " & _
"'" & rs!Changed & "', " & _
"'" & rs!JobGroupCode & "', " & _
"'" & rs!JobDesc & "', " & _
"'" & rs!JobGroup & "')"
qdf.ReturnsRecords = False
On Error GoTo Update_qdfError
qdf.Execute dbFailOnError
On Error GoTo 0
rs.MoveNext
Loop
rs.Close
Set qdf = Nothing
Set cdb = Nothing
Set rs = Nothing
Exit Function
Update_qdfError:
For Each err In DAO.Errors
MsgBox err.Description, vbCritical, "Error " & err.Number
Next
End Function
So is there a way I can modify the Connection code and add it to the update code (minus the message boxes) so if the connection cuts off it will terminate the code?
Did you try out transactions? Wrapping your insert script inside a transaction will not change the database until you've explicitly committed the transaction. If the data connection is lost during the inserts, the commit will never be called, and the SQL Server data won't be changed.
See http://msdn.microsoft.com/en-us/library/office/ff196400%28v=office.15%29.aspx