private Command1_Click()
Dim a as string
a = text1.text
OpenQuery "SELECT * FROM a WHERE Chair;"
txtChair.Text = myRs.Fields(0).Value
myRs.MoveNext
loop
end sub
Your code sample is missing a an opening Do statement, possibly an over site. Also, #nabuchodonossor is correct in that at best a the end of the loop the value of field(0) for the last record will be in txtChair.Text. But what you're asking for help with is to build a single string query where you are substituting a variable value for part of the string.
Private Command1_Click()
Dim a as string
a = text1.text
'this query isn't right, but not sure what to do with it
'this is something like normally "WHERE Field = 'Chair'"
OpenQuery "SELECT * FROM " & a & " WHERE Chair;" 'The & concatenates the separate strings
Do While rs.EOF = False
txtChair.Text = myRs.Fields(0).Value
myRs.MoveNext
Loop
End Sub
MSDN link to the & Operator
Related
I am trying to convert string to double in UFT but It shows the output without decimal point. below is the code for reference.
vStr = "1000000.589765"
msgbox Typename(vStr)
strV1=CDBL(formatNumber(vStr,4))
msgbox Typename(strV1)
print strV1
Output: 1000000589765
Note that without formatNumber, its not working.
Yet another implementation using DotNetFactory. Just an another thought. I am not denying to use CDbl. But worth to give a shot.
'Test Code
Dim strConvertedCode
strConvertedCode = ConvertDataType("1000000.589765","Double")
If strConvertedCode <> null Then
Msgbox strConvertedCode
End If
Public Function ConvertDataType(ByVal SourceData,ByVal ConversionDataType)
'Initialization of variables
Dim objDotNetFactory
Dim strConvertedData : strConvertedData = null
Dim strSystemNamespace
'Determine the destination data type
Select Case UCase(ConversionDataType)
Case "DOUBLE"
strSystemNamespace = "System.Double"
'Implement further for your data types
'Reference https://msdn.microsoft.com/en-us/library/ms228360(v=vs.90).aspx
Case Default
Set objDotNetFactory = DotNetFactory.CreateInstance("System.Int32")
End Select
Set objDotNetFactory = DotNetFactory.CreateInstance(strSystemNamespace)
'Check the dot net factory instance is successful
If Not IsObject(objDotNetFactory) Then
Reporter.ReportEvent micWarning,"Data type convertor","Conversion from String to " & ConversionDataType & " failed, Since DotNetFactory instance was not created."
ConvertDataType = strConvertedData
Exit Function
End If
strConvertedData = objDotNetFactory.Parse(SourceData)
ConvertDataType = strConvertedData
End Function
I have a datagrid linked to an access database in VB6. how do i sort the data in ascending order when the user clicks the command button.
My Code:
Private Sub Form_Load()
connSearch.Open connstr
Adodc1.ConnectionString = Conn.connstr
Set StudentTable.DataSource = Adodc1
Adodc1.Visible = False
End Sub
Private Sub cmdSort_Click()
Dim LNsql As String
connSearch.Close
connSearch.Open connstr
LNsql = "select * from Table1 order By LastName" & " " & StudentTable.Columns(2).Caption & "Asc"
StudentTable.Refresh
End Sub
If your recordset's CursorLocation property is set to adUseClient you don't need to close and re-open the recordset. Just use the Recordset.Sort method.
Private Sub cmdSort_Click()
Adodc1.Recordset.Sort = "LastName" 'data field name
End Sub
Help my code got wrong it says:
Either BOF or EOF is True, or the current record has been deleted,Requested operation requires a current record.
i think this rs.close has a problem or where can i set the rs.close? because i set and used recordset twice.
anyone can help? please fix my code.
Public Function borrowersName(ByVal Iname, ByVal Imod, ByVal Icat, ByRef BFname, ByRef BLname) As Boolean
Dim dateReturned As String
'select firt the primary key of the item
qry1 = "select tblitem_id from tblitem inner join tblcategory on tblitem.tblcategory_id=tblcategory.tblcategory_id where tblitem.item_name='" + Iname + "' and tblitem.item_model='" + Imod + "' and tblcategory.category_name='" + Icat + "'"
rs.Open qry1, conn
qry1Result = rs.Fields(0).Value
rs.Close
qry2 = "SELECT date_returned,Firstname,Lastname FROM tblborrowers where tblitem_id='" & qry1Result & "' ORDER BY tblborrowers_id DESC LIMIT 1"
rs.Open qry2, conn
dateReturned = rs.Fields(0).Value
If dateReturned <> "" Then
borrowersName = True
BFname = rs.Fields(1).Value
BLname = rs.Fields(2).Value
Else
borrowersName = False
End If
Set rs = Nothing
End Function
You do have the recordset Open and Close methods in the right order, so there is no problem there.
The error "Either BOF or EOF is True, or the current record has been deleted" simply means that one of your SELECT queries has returned zero records. What you do about that depends on your requirements. For example, you could test for Not rs.EOF before attempting to read a field value.
I'm trying to pre-view if a field of the recordset is empty/null or not.
If IsNull(rs.Fields("fieldname")) = True Then ...
If IsNull(rs.Fields("fieldname")).Value = True Then ...
if IsNull(rs.Fields("fieldName").Value) Then...
All of these methods fires up an error... Why? How may I check if the recordset is null before I assign it's value to a variable.
If I understand correctly, you want to ensure that a field exists in the recordset. If that is correct, you need to either iterate the fields looking for the field you are searching for, or try to directly access the field and trap any errors. Here is a method that iterates the field collection and returns True if the field exists.
Public Function FieldExists(ByVal rsRecSet As ADODB.Recordset, ByVal FieldName As String) As Boolean
Dim fld As ADODB.Field
Dim Rtn As Boolean
If Not rsRecSet Is Nothing Then
For Each fld In rsRecSet.Fields
If StrComp(fld.Name, FieldName, vbTextCompare) = 0 Then
Rtn = True
Exit For
End If
Next fld
End If
FieldExists = Rtn
End Function
Here is a way to print out the columns of a table.
Dim cat
Set cat = CreateObject("ADOX.Catalog")
Set cat.ActiveConnection = db 'db is the adodb.connection object
Dim tbl
Dim clm
For Each tbl In cat.Tables
For Each clm In tbl.Columns
Debug.Print (clm) ' Prints the column name from the table
Next
Next
Try using IsDbNull() instead. DbNull is different than Null.
Edit, just loop through the field names and have a boolean if it found it, otherwise use a try catch structure.
For Each field in rs.Fields
if field.Name = "someFieldName" then
foundField = true
exit for
else
foundField = false
end if
next
I'm using AtValue and AtField helpers like this
Option Explicit
Private Sub Form_Load()
Dim rs As Recordset
If IsEmpty(AtValue(rs, "Test")) Then
Debug.Print "Field is Empty or non-existant"
End If
If LenB(C2Str(AtValue(rs, "Test"))) = 0 Then
Debug.Print "Field is Null, Empty, empty string or non-existant"
End If
'-- this will never fail, even if field does not exist
AtField(rs, "Test").Value = 42
End Sub
Public Function AtValue(rs As Recordset, Field As String) As Variant
On Error GoTo QH
AtValue = rs.Fields(Field).Value
Exit Function
QH:
' Debug.Print "Field not found: " & Field
End Function
Public Function AtField(rs As Recordset, Field As String) As ADODB.Field
Static rsDummy As Recordset
On Error GoTo QH
Set AtField = rs.Fields(Field)
Exit Function
QH:
' Debug.Print "Field not found: " & Field
Set rsDummy = New Recordset
rsDummy.Fields.Append Field, adVariant
rsDummy.Open
rsDummy.AddNew
Set AtField = rsDummy.Fields(Field)
End Function
Public Function C2Str(Value As Variant) As String
On Error GoTo QH
C2Str = CStr(Value)
QH:
End Function
My type-casting helpers are actually using VariatChangeType API (so to work with Break on all errors setting) like this
Public Function C_Str(Value As Variant) As String
Dim vDest As Variant
If VarType(Value) = vbString Then
C_Str = Value
ElseIf VariantChangeType(vDest, Value, VARIANT_ALPHABOOL, VT_BSTR) = 0 Then
C_Str = vDest
End If
End Function
rs.EOF flag will tell whether RecordSet is Empty or not
If Not rs.EOF Then
..Your desired logic..
End If
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.