This is my first time asking a question here but I am completely puzzled by this. I'm currently making a small scheduling app as a side project but I keep running into this bug after I run my program. The bug is that I have made some changes to my database like adding a column Day_Night_Shift but after running the program it sometimes eliminates the row. Its like it reverts back to the old database. I am currently using an access database with accdb file.
so far I do a some inserts and select statements in the program.
the first is the select statement which goes to this function to fill a dgv box.
Public Function executeQuery(ByVal querystr As String) As DataTable
'opens accdb database file and fills datatable with wanted query. returns datatable for use.
Dim dt As New DataTable
Using da As New OleDb.OleDbDataAdapter(querystr, connstr)
da.Fill(dt)
da.Dispose()
End Using
Return dt
End Function
the other function I use is with inserting
Public Function InsertNewEmp(ByVal firstname As String, ByVal lastname As String, ByVal position As String, ByVal shift As String) As String
Dim insertstring As String = "INSERT INTO Tbl_Employee ([Employee First Name], [Employee Last Name], [Position ID], [Day or night]) VALUES ('" & _
firstname & "', '" & lastname & "', " & position & ", '" & shift & "') "
Try
cnnOLEDB = New OleDbConnection(connstr)
cnnOLEDB.Open()
cmdOLEDB = New OleDbCommand(insertstring, cnnOLEDB)
cmdOLEDB.ExecuteNonQuery()
cnnOLEDB.Close()
Catch ex As Exception
Return "insert failed," & ex.Message
End Try
Dim data As DataTable = executeQuery("SELECT [Employee ID] from Tbl_Employee where [Employee First Name] = '" & firstname & _
"' and [Employee Last Name] = '" & lastname & "' and [Position ID] = " & position & _
" and [Day or Night] = '" & shift & "'")
Dim successmsg As String
Dim rows() As DataRow = data.Select()
Dim lastrow As Integer = rows.GetUpperBound(0)
successmsg = (rows(rows.GetUpperBound(0))(0))
Return "insert successful Employee id=" & successmsg
If anyone is able to assist with this it would be much appreciated. Its not resetting the database all the time just some times but its a little annoying when i'm trying to debug etc.
Thank you in advance
Ok, first of: its not really an error.
What happens is when you start up your project visualBasic loads the database into a container. It saves and stores any data added, edited and/or deleted to this container. Once you close visual basic and opens it again its gone. I had this issue myself and as just as puzzled until i tried finishing and installing the program it all seemed to work perfectly fine.
It's no big deal at all, but i would advice keeping away from auto-generated stuff and use proper SQL, this way you don't have this issue and have better control over your database
Related
I have a list of data from a database displayed in a datagrid view. Whenever I delete one record, it successfully deletes it from the table and also in the database but when I try to delete another record, the delete function doesn't work anymore.
Here is my code:
Private Sub cmdDelete_Click()
Set Connect = New Class1
Set rxdelete = New ADODB.Recordset
Dim sqlString, dataID, answer As String
dataID = lblID.Caption
sqlString = "DELETE FROM tblloan WHERE ID = '" & Trim$(dataID) & "'"
answer = MsgBox("Are you sure you want to delete this record?", vbYesNo, "RheaLending")
If answer = vbYes Then
rxdelete.Open sqlString, con, 3, 3
Call refreshList
Else
Call refreshList
End If
End Sub
Here is the code for refreshList:
Sub refreshList()
Set Connect = New Class1
Set rxloan = New ADODB.Recordset
rxloan.Open "SELECT * FROM tblloan LIMIT 100", con, 3, 3
lblLNumberRecords.Caption = Format(rxloan.RecordCount, "###,###,###.##")
Set DatLoans.DataSource = rxloan
DatLoans.SetFocus
End Sub
Please somebody help me!
I am using vb6, adodb and mysql database.
your delete statement does not return a result set other than the number of records deleted. use an adodb.command instead of a .recordset. another thing is you are not killing your objects it can cause you greef in the long run because the app can slow down.
Set rxdelete = New ADODB.command
set rxdelete.currentconneciton = [your connection object]
rxdelete.commandtext = "DELETE FROM tblloan WHERE ID = '" & Trim$(dataID) & "'"
rxdelete.execute
'at the bottom of your sub
set rxdelete=nothing
set connect = nothing
Getting this error out of an old VB6 app that I've been presented with updating. So I got XP Mode up and running and VB6 installed and updated on it and I've added the menu option that was requested of me, but now I'm getting this error.
There are several examples of this error or similar here on SO and I looked through a bunch of them, but the circumstances aren't exactly the same and I'm still a pretty newbie developer and I just need help. I tested the query I wrote on our dev server and the VB syntax around it, that part is working fine. I think it has something to do with the result set logic near the end:
Private Sub FillDoor()
Dim m_rsDoor As ADODB.Recordset
cboDoorStyle.Clear
Set m_rsDoor = conSQL.Execute("SELECT bpm.[Description] " & _
"FROM tblBrandProductMaster bpm " & _
"INNER JOIN tblDoorStyles ds " & _
"ON ds.DoorStyleCode = bpm.Code " & _
"INNER JOIN tblFamilyDoorStyles fds " & _
"ON bpm.Code = fds.DoorStyleCode " & _
"INNER JOIN tblFamilyLines fl " & _
"ON fds.FamilyLineCode = fl.FamilyLineCode " & _
"WHERE fl.FamilyLineCode = '" & strFamID & "' " & _
"AND ds.DFFactive = 1 " & _
"ORDER BY bpm.[Description] ASC")
Do While Not m_rsDoor.EOF
cboDoorStyle.AddItem m_rsDoor!Description
m_rsDoor.MoveNext
Loop
Set m_rsDoor = Nothing
End Sub
****Edit: I'm using that query to populate a particular drop-down in the app and it is working on both on the SQL server and in the app.
Some of the examples on here use an If loop instead of a Do While Not, but they both get the same thing done and I don't think that's the issue. I also don't think that's the issue because I copied and pasted that part from another menu option on the app and that option works when I click it. It only throws the error when I choose the option I added.
Thanks, I appreciate any help anyone can offer.
Modify like below code:
Private Sub FillDoor()
Dim m_rsDoor As ADODB.Recordset
Set m_rsDoor = New Recordset
Dim ActiveConnection as String
ActiveConnection = "XXXXXXXXXXX"
Dim strSQL as String
strSQL = "SELECT bpm.[Description] " & _
"FROM tblBrandProductMaster bpm " & _
"INNER JOIN tblDoorStyles ds " & _
"ON ds.DoorStyleCode = bpm.Code " & _
"INNER JOIN tblFamilyDoorStyles fds " & _
"ON bpm.Code = fds.DoorStyleCode " & _
"INNER JOIN tblFamilyLines fl " & _
"ON fds.FamilyLineCode = fl.FamilyLineCode " & _
"WHERE fl.FamilyLineCode = '" & strFamID & "' " & _
"AND ds.DFFactive = 1" & _
"ORDER BY bpm.[Description] ASC"
m_rsDoor.open strSQL, ActiveConnection, adOpenStatic, adLockOptimistic
Do While Not m_rsDoor.EOF
cboDoorStyle.AddItem m_rsDoor!Description
m_rsDoor.MoveNext
Loop
Set m_rsDoor = Nothing
End Sub
This error comes when there are no record in the record set. Please check if your query is correct and giving records.
I'm using vb6 and sql server.in which on the form load I'm filling 4 combobox.But its taking 10 to 12 minutes to load the form.
My code is as follows:
Can anybody help me to make the form load fast?
Public Sub fillCombo(Id As String, Name As String, Table As String, obj As Object, Optional cond As String)
Dim rsF As New ADODB.Recordset
With rsF
If .State = adStateOpen Then .Close
If cond = "" Then
.Open "Select " & Id & "," & Name & " From " & Table & " Order by " & Name, Cn, adOpenKeyset, adLockOptimistic
Else
.Open "Select " & Id & "," & Name & " From " & Table & " Where " & cond & " Order by " & Name, Cn, adOpenKeyset, adLockOptimistic
End If
obj.Clear
'obj.AddItem ""
While Not .EOF
obj.AddItem .Fields(1)
obj.ItemData(obj.NewIndex) = .Fields(0)
.MoveNext
Wend
.Close
End With
End Sub
function call is as follows:
fillCombo "JobId", "JobName", "Jobs", cboJob
The problem (I believe) is that you are using a server-side recordset. When you do this, you are making one round trip to the server for each iteration of your loop, which is, as you have found, glacially slow.
The solution is to create a client-side recordset. That sends the data from the server to the client in one go. Keep in mind that client-side recordsets are always static; if you set the CursorType to adOpenKeyset the CursorLocation to adUseClient, the latter will override the former and your CursorType will still be adOpenStatic.
Here's a mod to your code, with various improvements (in particular, with your atrocious indenting corrected; you might consider being a bit nicer to the poor folks who have to work with your code down the line when you write it):
Public Sub fillCombo(Id As String, Name As String, Table As String, obj As Object, Optional cond As String)
Dim sql As String
Dim rsF As ADODB.Recordset 'Don't use "As New" in VB6, it's slow
'sql variable with ternary conditional (IIf) is cleaner way to do what you want
sql = "Select " & Id & "," & Name & " From " & Table & IIf(cond = "", "", " Where " & cond) & " Order by " & Name
Set rsF = New ADODB.Recordset
With rsF
.CursorLocation = adUseClient 'Client-side, static cursor
'If .State = adStateOpen Then .Close --Get rid of this: if you just created rsF, it can't be open, so this is a waste of processor cycles
.Open sql, Cn 'Much prettier, yes? :)
obj.Clear 'All this is fine
Do Until .EOF
obj.AddItem .Fields(1)
obj.ItemData(obj.NewIndex) = .Fields(0)
.MoveNext
Loop
.Close
End With
End Sub
I am using .Open to check if record exists.
If it exists, I delete it.
If not, I an adding it.
Then I close the ADODB Recordset.
I am sure there is a better way of doing this - and this is probably a slow way of doing it.
Is there a way of doing this with only one Open and One close?
Here is my code (which is in a Do Loop):
Dim myRecSet As New ADODB.Recordset
Dim strSql As String
strSql = "select * from RentBalances where KeyTcyIdSubAcDate = '" & sKeyTcyIdSubAcDate & "'"
'Display "SQL: " & strSql
myRecSet.Open strSql, SQLSVSExtractConnection, adOpenKeyset, adLockOptimistic
'Display "Total no of records = " & myRecSet.RecordCount
If myRecSet.RecordCount < 1 Then
'Display ("There are no RentBalances record for this ID. ID = " & sKeyTcyIdSubAcDate)
Else
' delete the record
myRecSet.Delete
myRecSet.UpdateBatch
End If
myRecSet.AddNew
myRecSet!KeyTcyIdSubAcDate = rsLocal.Fields("KeyTcyIdSubAcDate")
myRecSet!KeyTcyId = rsLocal.Fields("KeyTcyId")
myRecSet!SubAc = rsLocal.Fields("SubAc")
myRecSet!PeriodEndDate = rsLocal.Fields("PeriodEndDate")
myRecSet!Amount = rsLocal.Fields("Amount")
myRecSet!RentAmount = rsLocal.Fields("RentAmount")
myRecSet!ChargesAmount = rsLocal.Fields("ChargesAmount")
myRecSet!AdjustmentAmount = rsLocal.Fields("AdjustmentAmount")
myRecSet!BenefitAmount = rsLocal.Fields("BenefitAmount")
myRecSet!BenefitBalance = rsLocal.Fields("BenefitBalance")
myRecSet!TenantBalance = rsLocal.Fields("TenantBalance")
myRecSet!PayAmount = rsLocal.Fields("PayAmount")
myRecSet!TimeStamp = rsLocal.Fields("TimeStamp")
myRecSet!UpdateFlag = rsLocal.Fields("UpdateFlag")
myRecSet.Update
myRecCount = myRecCount + 1
myRecSet.Close
The most optimal way of doing this is to bulk insert into a staging table from your code and then call a stored procedure to merge the data from your staging table into your proper table.
I'm trying to figure out how to speed up this operation. Before I import a record from the text file I first need to see if one exists in the database. If it does exist I'm going to perform an update operation on it. If it does not exist I'm going to create a new record.
Running the code you see below this operation takes somewhere in the neighborhood of 3 hours.
I've tried using ADO's find method and it actually appears to be slower than the filter method.
The database is a Visual Foxpro 6 database. The table does have an index on the item_cd field but the table does not have any primary key established. This is out of my control since I didn't write the software and I'm trying to stay away from making any structural changes to the database.
There are 46652 rows in the text file and about 650,000 records/rows in the ADO recordset. I think slimming down the recordset would be the biggest step in fixing this but I haven't come up with any way of doing that. I'm trying to prevent creating duplicate records since there is no primary key and so I really need to have the entire table in my recordset.
Because I'm running this on my local machine it appears that the operation is limited by the power of the CPU. In actuality this might be used across the network, especially if I can get it to go faster.
Dim sFileToImport As String
sFileToImport = Me.lstFiles.Text
If sFileToImport = "" Then
MsgBox "You must select a file from the listbox to import."
Exit Sub
End If
If fConnectToDatabase = False Then Exit Sub
With gXRst
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockReadOnly
.Open "SELECT item_cd FROM xmsalinv ORDER BY item_cd ASC", gXCon
End With
Call fStartProgress("Running speed test.")
Dim rstTxtFile As ADODB.Recordset
Set rstTxtFile = New ADODB.Recordset
Dim con As ADODB.Connection
Set con = New ADODB.Connection
Dim sConString As String, sSQL As String
Dim lRecCount As Long, l As Long
Dim s As String
sConString = "DRIVER={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & gsImportFolderPath & ";Extensions=asc,csv,tab,txt;Persist Security Info=False;"
con.Open sConString
sSQL = "SELECT * FROM [" & sFileToImport & "]"
rstTxtFile.Open sSQL, con, adOpenKeyset, adLockPessimistic
If Not (rstTxtFile.EOF And rstTxtFile.BOF) = True Then
rstTxtFile.MoveFirst
lRecCount = rstTxtFile.RecordCount
Do Until rstTxtFile.EOF = True
'This code appears to actually be slower than the filter method I'm now using
'gXRst.MoveFirst
'gXRst.Find "item_cd = '" & fPQ(Trim(rstTxtFile(0))) & "'"
gXRst.Filter = "item_cd = '" & fPQ(Trim(rstTxtFile(0))) & "'"
If Not (gXRst.EOF And gXRst.BOF) = True Then
s = "Item Found - " & Trim(rstTxtFile(0)) 'item found
Else
s = "Item Not Found - " & Trim(rstTxtFile(0)) 'Item not found found
End If
l = l + 1
Call subProgress(l, lRecCount, s)
rstTxtFile.MoveNext
Loop
End If
Call fEndProgress("Finished running speed test.")
Cleanup:
rstTxtFile.Close
Set rstTxtFile = Nothing
gXRst.Close
A simple solution to speed up Yours_Rs.find response is to use the Yours_Rs.move statement first if it is possible for you. What I have done is to use MyRs.move statement prior to using MyRs.find to come in the vicinity of my actual record. It had really worked for me as response of move statement is quite brisk.
I was using it to locate a patient record. So, moving the pointer to a record near the actual record made MyRs.find statement to work with the speed of light.
regards,
MAS.
doesn't answer your question and this is a pretty old thread, but
why don't you import your text file to a temporary table on your db then do a join?
something like
SELECT tt.* FROM texttemp tt left outer join xmsalinv xal on tt.field1=xal.item_cd where xal.item_cd is null
this should return the contents of your imported text file which don't have any item_cd matches in the database, since you're dealing with a text file that complicates the query which is why i'm wondering your not importing the contents to a temporary table.
now assuming you know the mapping of the fields, you can probably also use this to insert assuming your db accepts insert select notation it'd be insert into xmsalinv (fields) select (matching fields) from (as above...)
this moves your choke points to the import process, which i'm hoping is quick.
the ado collections seem like they're pretty stupid, so they don't benefit from any sort of knowledge about the data and are kinda slow.
ah next item on "vb6 filter" google http://www.techrepublic.com/article/why-ados-find-method-is-the-devil/1045830
this response is based on basic sql knowledge and not tailored to foxpro
Use a firehose cursor for the VFP query's results if you aren't, and see your other post here for suggestions regarding the text file Recordset.
Perhaps better yet though, you might try getting rid of your slow "loop and search" aproach.
I would probably create a temporary Jet 4.0 MDB from scratch for each text file you want to look up. Import the text data, index your key field. Use ADOX to define a linked table over in the VFP database. The use a query to do your matching.
Close and dispose of the MDB afterward.
In response to Bob Riemersma's post, the text file is not causing the speed issues. I've changed my code to open a recordset with a query looking for a single item. This code now runs in 1 minute and 2 seconds as opposed to the three to four hours I was looking at the other way.
Dim sFileToImport As String
sFileToImport = Me.lstFiles.Text
If sFileToImport = "" Then
MsgBox "You must select a file from the listbox to import."
Exit Sub
End If
If fConnectToDatabase = False Then Exit Sub
Call fStartProgress("Running speed test.")
Dim rstTxtFile As ADODB.Recordset
Set rstTxtFile = New ADODB.Recordset
Dim con As ADODB.Connection
Set con = New ADODB.Connection
Dim sConString As String, sSQL As String
Dim lRecCount As Long, l As Long
Dim sngQty As Single, sItemCat As String
sConString = "DRIVER={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & gsImportFolderPath & ";Extensions=asc,csv,tab,txt;Persist Security Info=False;"
con.Open sConString
sSQL = "SELECT * FROM [" & sFileToImport & "]"
rstTxtFile.Open sSQL, con, adOpenKeyset, adLockPessimistic
If Not (rstTxtFile.EOF And rstTxtFile.BOF) = True Then
rstTxtFile.MoveFirst
lRecCount = rstTxtFile.RecordCount
Do Until rstTxtFile.EOF = True
l = l + 1
sItemCat = fItemCat(Trim(rstTxtFile(0)))
If sItemCat <> "[item not found]" Then
sngQty = fItemQty(Trim(rstTxtFile(0)))
End If
Call subProgress(l, lRecCount, sngQty & " - " & sItemCat & " - " & rstTxtFile(0))
sngQty = 0
rstTxtFile.MoveNext
Loop
End If
Call fEndProgress("Finished running speed test.")
Cleanup:
rstTxtFile.Close
Set rstTxtFile = Nothing
My Functions:
Private Function fItemCat(sItem_cd As String) As String
'Returns blank if nothing found
If sItem_cd <> "" Then
With gXRstFind
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockReadOnly
.Open "SELECT item_cd, ccategory FROM xmsalinv WHERE item_cd = '" & fPQ(sItem_cd) & "'", gXCon
End With
If Not (gXRstFind.EOF And gXRstFind.BOF) = True Then
'An item can technically have a blank category although it never should have
If gXRstFind!ccategory = "" Then
fItemCat = "[blank]"
Else
fItemCat = gXRstFind!ccategory
End If
Else
fItemCat = "[item not found]"
End If
gXRstFind.Close
End If
End Function
Private Function fIsStockItem(sItem_cd As String, Optional bConsiderItemsInStockAsStockItems As Boolean = False) As Boolean
If sItem_cd <> "" Then
With gXRstFind
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockReadOnly
.Open "SELECT item_cd, bal_qty, sug_qty FROM xmsalinv WHERE item_cd = '" & fPQ(sItem_cd) & "'", gXCon
End With
If Not (gXRstFind.EOF And gXRstFind.BOF) = True Then
If gXRstFind!sug_qty > 0 Then
fIsStockItem = True
Else
If bConsiderItemsInStockAsStockItems = True Then
If gXRstFind!bal_qty > 0 Then
fIsStockItem = True
End If
End If
End If
End If
gXRstFind.Close
End If
End Function
Private Function fItemQty(sItem_cd As String) As Single
'Returns 0 if nothing found
If sItem_cd <> "" Then
With gXRstFind
.CursorLocation = adUseClient
.CursorType = adOpenKeyset
.LockType = adLockReadOnly
.Open "SELECT item_cd, bal_qty FROM xmsalinv WHERE item_cd = '" & fPQ(sItem_cd) & "'", gXCon
End With
If Not (gXRstFind.EOF And gXRstFind.BOF) = True Then
fItemQty = CSng(gXRstFind!bal_qty)
End If
gXRstFind.Close
End If
End Function
First can try creating an in-memory index on item_cd with gXRst!item_cd.Properties("OPTIMIZE").Value = True which will speed up both Find and Filter.
For ultimate speed in searching initialize helper index Collection like this
Set cIndex = New Collection
On Error Resume Next
Do While Not gXRst.EOF
cIndex.Add gXRst.Bookmark, "#" & gXRst!item_cd.Value
gXRst.MoveNext
Loop
On Error GoTo ErrorHandler
And insetad of Find use some function like this
Public Function SearchCollection(Col As Object, Index As Variant) As Boolean
On Error Resume Next
IsObject Col(Index)
SearchCollection = (Err.Number = 0)
On Error GoTo 0
End Function
3 hours just for a few hundred thousands of records!!! You are doing it the wrong way. Simply:
-append text file to a VFP table,
-then insert the ones that do not exist in existing table with a single SQL
-and update the ones that exist with another Update sql.
That is all and should take less than a minute (a minute is even very slow). You can do all these using the VFPOLEDB driver and it doesn't matter that you have VFP6 database, VFPOLEDB has VFP9 engine built-in.