I've been working on a program that appears to work fine but for some unexplained reason I get a
Run-Time error '3709' The connection cannot be used to perform this operation. It is either closed or invalid in this context.
This part of the program exports records it find that match the Export by filter
The error appears when I select Export by Entity.
Here is my code - Anyone see anything?
HTML Code:Private Sub cmdExport_Click() Dim lRS As New ADODB.Recordset Dim x As ListItem Dim thefile As String Dim lData As String, lSeparator As String CommonDialog1.FileName = "" CommonDialog1.DialogTitle = "Save As Text File" CommonDialog1.Filter = "CSV Files (*.csv)|*.csv|Text Files (*.txt)|*.txt|All Files (*.*)|*.*|" CommonDialog1.ShowSave thefile = CommonDialog1.FileName If thefile <> "" Then If Option1.Value Then lSeparator = "|" ElseIf Option2.Value Then lSeparator = "," ElseIf Option3.Value Then lSeparator = ", " ElseIf Option4.Value Then lSeparator = vbTab ElseIf Option5.Value Then lSeparator = txtOther.Text End If lRS.Open "select * from tblEntries order by fldEntity", gConn, adOpenStatic, adLockReadOnly 'check if there are records If Not lRS.EOF Then lData = "Entity" & lSeparator & "Unit" & lSeparator & "Observer" & lSeparator & "Month" & lSeparator & "Year" & lSeparator & "Typehealthcare" & lSeparator & "Patientcontact" & lSeparator & "Compliance" & lSeparator & "Gown" & lSeparator & "Gloves" & lSeparator & "Surgicalmask" & lSeparator & "N95mask" & vbCrLf While Not lRS.EOF lData = lData & lRS.Fields("fldEntity").Value & lSeparator & lRS.Fields("fldUnit").Value & lSeparator & lRS.Fields("fldObserver").Value & lSeparator & Format$(CDate(lRS.Fields("fldMonth").Value & "/1/" & lRS.Fields("fldYear").Value), "mmm") & lSeparator & lRS.Fields("fldYear").Value & lSeparator & _ lRS.Fields("fldHealthcareWorkerType").Value & lSeparator & lRS.Fields("fldPatientContact").Value & lSeparator & lRS.Fields("fldCompliance").Value & lSeparator & lRS.Fields("fldGown").Value & lSeparator & lRS.Fields("fldGloves").Value & lSeparator & lRS.Fields("fldSurgicalMask").Value & lSeparator & lRS.Fields("fldN95Mask").Value & vbCrLf lRS.MoveNext Wend If lRS.State <> adStateClosed Then lRS.Close 'Save data to file Call SaveStringToFile(lData, thefile) MsgBox "Done export.", vbInformation, g_AppName Else MsgBox "No record found.", vbExclamation, g_AppName End If End If End Sub


Reply With Quote

