I have developed a winform which requires constant contact with a mysql database to make sure all "calls" are fetched and up to date - the problem I have run into is that my listview is only being populated with 1 line per timer click. this timer should activate a while statement that should process all data and in fact should also be clearing the listview to receive updated data. why is my listview only populating 1 item per tick?
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
ListView2.Items.Clear()
con.ConnectionString = "server=localhost;" _
& "user id=username;" _
& "password=password;" _
& "database=DMT"
adptr = New MySqlDataAdapter("SELECT * , s.fid AS sfid, s.name AS sname, s.faddress AS sfaddress, s.fcity AS sfcity, s.fstate AS sfstate, s.fcontnumb AS sfcontnumb, s.fcontname AS sfcontname, s.fcontract AS sfcontract, d.fid AS dfid, d.name AS dname, d.faddress AS dfaddress, d.fcity AS dfcity, d.fstate AS dfstate, d.fcontnumb AS dfcontnumb, d.fcontname AS dfcontname, d.fcontract AS dfcontract FROM calls c LEFT JOIN facilities s ON c.Scene = s.fid LEFT JOIN facilities d ON c.Dest = d.fid WHERE putime < now( ) + INTERVAL 12 HOUR && Rdisp IS NULL ORDER BY putime desc", con)
Try
adptr.Fill(pendrun)
Catch err As Exception
Dim strError As String = "Exception: & err.ToString()"
End Try
If pendrun.Rows.Count > 0 Then
While pop < pendrun.Rows.Count - 1
TempStr(0) = pendrun.Rows(pop)("RID")
Select Case pendrun.Rows(pop)("Utype")
Case 1
TempStr(1) = "BLS Ambulance"
Case 2
TempStr(1) = "ALS Ambulance"
Case 3
TempStr(1) = "SCT Ambulance"
Case 4
TempStr(1) = "Wheelchair Van"
Case 5
TempStr(1) = "Taxi"
End Select
Select Case pendrun.Rows(pop)("Curgency")
Case 1
TempStr(2) = "Scheduled"
Case 2
TempStr(2) = "Non-Scheduled"
Case 3
TempStr(2) = "ASAP"
Case 4
TempStr(2) = "STAT"
End Select
TempStr(3) = pendrun.Rows(pop)("Pname")
TempStr(4) = pendrun.Rows(pop)("Texttime")
TempStr(5) = pendrun.Rows(pop)("sname") & " - " & pendrun.Rows(pop)("sfaddress") & ", " & pendrun.Rows(pop)("sfcity") & ", " & pendrun.Rows(pop)("sfstate")
TempStr(6) = pendrun.Rows(pop)("dname") & " - " & pendrun.Rows(pop)("dfaddress") & ", " & pendrun.Rows(pop)("dfcity") & ", " & pendrun.Rows(pop)("dfstate")
TempNode = New ListViewItem(TempStr)
ListView2.Items.Add(TempNode)
pop += 1
End While
End If
End Sub
I have verified it is in fact linked to the timer directly (1 item per tick) by varying the timer from 1 second to 30 seconds and it does directly change this.
Your code never resets "pop"'s value. That's what's causing trouble, I'm pretty sure. It keeps incrementing 1 value every tick, never able to do all of them because pop is set to one less than the while's max.
Related
I have two txt boxes and two combo boxes on a form. There is also a subform linked to the temptable that I want to have rebuilt/filter each time one of the controls is changed (using after update on each control to trigger the following sub)
I receive Run-time error '91: Object variable or with block variable not set on line Items(i) = Thing
I am not sure using " (i) " works with MS Access 365 or I am dimensioning incorrectly?
Thank you.
Private Sub Lookupstuff()
Dim i As Integer
Dim Items(1 To 4) As Object
sql = "DELETE * FROM tblTemp"
CurrentDb.Execute sql
i = 0
FilterArray = Array(Me.txtNew, Me.cmbS, Me.cmbP, Me.txtSl)
For Each Thing In FilterArray
If Not IsNull(Thing) Then
i = i + 1
Items(i) = Thing <--Error is here. Items(i) is empty.
End If
Next
If i = 0 Then
Forms!frmNew.Requery
Forms!frmNew.Refresh
End If
If i = 1 Then
Filter = Items1
End If
If i = 2 Then
Filter = Items1 & " AND " & Items2
End If
If i = 3 Then
Filter = Items1 & " AND " & Items2 & " AND " & Items3
End If
If i = 4 Then
Filter = Items1 & " AND " & Items2 & " AND " & Items3 & " AND " & Items4
End If
sql = "INSERT INTO tblTemp SELECT * FROM tblQ"
If Not IsNull(Filter) Then
sql = sql & " WHERE " & Filter
End If
CurrentDb.Execute sql
Forms!frmNew.Requery
Forms!frmNew.Refresh
End Sub
Since you are assigning a reference to object in the array, you must use Set, i.e.:
Set Items(i) = Thing
Also, presumably each reference to Items1, Items2 etc. should actually be Items(1), Items(2) in order to access the objects referenced at these indices of the array.
I get this error :Invalid attempt when no data is present.It says that line 39 and 198 are the causes of this error
LINE 39
Sub loadstudent()
lvstudent.Items.Clear()
While RD.Read
With lvstudent.Items.Add(RD(1), 0)
.SubItems.Add(RD(5)) '48
.SubItems.Add(RD(0))
End With
End While
End Sub
LINE 198:
sSql = "Select * from tblstudentprof where status='ACTIVE' "
execSQL(sSql, False)
loadstudent()
I also used looping to count the selected items in a listview and move it to tblstudentprof which is connected to line 148 and line 39.
Private Sub btnmove_Click(sender As Object, e As EventArgs) Handles btnmove.Click
Dim ctr, count, minus As Integer
ctr = lvstudent.Items.Count - 1
While ctr >= 0
If lvstudent.Items(ctr).Checked = True Then
sSql1 = "Update tblstudentprof set secid='" & txtsecid.Text & "',yrlevelid='" & txtyrlevelid.Text & _
"',remarks='ENLISTED' where studid ='" & lvstudent.Items(ctr).SubItems(2).Text & "'"
execSQL1(sSql1, True)
ctr -= 1
End If
End While
count = lvstudent.Items.Count
minus = count - ctr1
If minus > 0 Then
MsgBox("There is/are " & minus & "updated students sections.")
Else
MsgBox("Successfully updated students sections.")
End If
I have an expenditures subform in Access 2010 that lists the predicted costs associated with the project for each year. Most projects only have one year, but some have more than one. Each cost has a Final checkbox next to it that should be checked when the amount is confirmed, ie. at the end of each year.
It basically looks something like this:
Year | Cost | Final
--------+-----------+--------------------
2017 | $100 | [checked box]
2018 | $200 | [unchecked box]
| | [unchecked box]
I have another field outside the table, FinalCost, that adds up everything in the Cost field. Right now, it fills in the amount from any year which has a checked Final box. That should only be filled when all the Final boxes are checked.
Ex. Right now, it should show nothing even though Final for 2017 is checked. When 2018 is checked, it should show $300. Instead, it shows $100 even though there's still an empty checkbox.
This is the code for this form.
Private Sub Form_AfterUpdate()
Dim rs1, rs2 As Recordset
Dim sql, sql2 As String
sql = "SELECT Sum(Amount) as Final From Expenditures " & _
"Where ProjNo = '" + Me.ProjNo + "' And Final = True Group by ProjNo"
sql2 = "SELECT FinalExpenditure From ActivityCash " & _
"Where ProjNo = '" + Me.ProjNo + "'"
Set rs1 = CurrentDb.OpenRecordset(sql, dbOpenDynaset, dpinconsistent)
Set rs2 = CurrentDb.OpenRecordset(sql2, dbOpenDynaset, dpinconsistent)
If rs1.RecordCount > 0 Then
If rs2.RecordCount > 0 Then
Do While Not rs2.EOF
rs2.Edit
rs2!FinalExpenditure = rs1!Final
rs2.Update
rs2.MoveNext
Loop
End If
End If
rs2.Close
rs1.Close
Set rs1 = Nothing
Set rs2 = Nothing
End Sub
What would be the best way to go about doing this?
EDIT: When the last box is checked, a new row is automatically added with an untoggled checkbox but no information.
Replace the statement beginning with sql = ... with this:
sql = "SELECT SUM(e1.Amount) AS Final " & _
" FROM Expenditures AS e1 " & _
" WHERE NOT EXISTS (SELECT 'x' FROM Expenditures e2 WHERE e2.Final=0 AND e1.ProjNo = e2.ProjNo) " & _
" AND e1.ProjNo = '" & Me.ProjNo & "'"
This query will return data only if there are all expeditures for the project marked as final. As you check for rs1.RecordCount > 0 there will be no update if this query returns no records.
So, before sql, I would verify that all records have True in your Final field.
To do that, let's just return a COUNT() of (any) records that have Final = False, and we can then decide to do what we want.
So, something like,
Dim Test as Integer
test = DCount("*", "YourTableName", "Final = False AND ProjNo = " & Me.ProjNo &"")
If test > 0 Then
'Don't fill the box
Else
'Fill the box, everything is True
'Read through your recordsets or whatever else you need to do
End If
To use a query, we essentially need to replicate the Dcount() functionality.
To do this, we need another Recordset variable, and we need to check the value of the Count() field from our query.
Create a query that mimicks this:
SELECT COUNT(*) As CountTest
FROM YourTable
HAVING Final = False
AND ProjNo = whateverprojectnumberyou'reusing
Save it, and remember that query's name.
Much like the DCount(), we need to make this "check" determine the route of your code.
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("YourQuery'sNameHere")
If rst!CountTest > 0 Then
'They are not all Checked (aka True)
Else
'Supply the value to the FinalCost
End If
Set rst = Nothing
Change this:
sql = "SELECT Sum(Amount) as Final From Expenditures " & _
"Where ProjNo = '" + Me.ProjNo + "' And Final = True Group by ProjNo"
For this:
"SELECT SUM(Amount) - SUM(IIF(Final,1,0)*Amount) as YetToConfirm, SUM(Amount) as Confirmed From Expenditures " & _
"Where ProjNo = '" + Me.ProjNo + "' Group by ProjNo"
rs1 will return two values, the total value if all costs were confirmed in the rs1!Confirmed, and the value yet to confirm in rs1!YetToConfirm
Then here:
Do While Not rs2.EOF
rs2.Edit
rs2!FinalExpenditure = rs1!Final
rs2.Update
rs2.MoveNext
Loop
change it to:
Do While Not rs2.EOF
rs2.Edit
rs2!FinalExpenditure = Iif(rs1!YetToConfirm = 0, rs1!Confirmed, 0)
rs2.Update
rs2.MoveNext
Loop
One way to process this would be check using a subquery whether last year(verified using a dmax function) in each project has been checked in the final column, if this is true, get your sum of checked amounts, else dont calculate the sum.
I have modified your sql string to include this and I tested it against your given example to confirm its showing a sum of $300 or nothing.
SQL = ""
SQL = SQL & " SELECT Sum(Amount) as Final From Expenditures "
SQL = SQL & " Where ProjNo = '" & Me.ProjNo & "' And Final = True "
SQL = SQL & " And (SELECT Expenditures.Final FROM Expenditures where year = ( "
SQL = SQL & " DMax('Year','Expenditures','ProjNo= " & Chr(34) & Me.ProjNo & Chr(34) & "'))) = true "
SQL = SQL & " Group by ProjNo "
I have retrieve all data from the internet into a 2 dimension array, I know how to use vba recordset and by filter and update using loop. Below is part of the code in vba.
the difficult problem is here:
Using cmd As New MySqlCommand("INSERT INTO `calls` (`CID`, `ctype`) VALUES (#CID, #ctype)", cnn)
This make me could not use any loop through the array and update accordingly.
cmd.Parameters.Add ('#CID').value = arrValue(i,j)
I hope this could be done in kind of below:
for x = 0 to ubound(arrValue,0)
for y = 0 to ubound(arrValue,1)
.fields(arrHeader(y) = arrValue(x,y)
next y
next x
say i, the n-th to be updated, j = the value of the header
extract of vba:
With rs
'Worksheets(strWsName).Activate
'iLastRow = Worksheets(strWsName).Cells(65535, 1).End(xlUp).row 'column B, column 2
For i = 0 To UBound(arrValue, 1)
Debug.Print "Updating " & i + 1 & " of " & UBound(arrValue, 1) + 1 & " news ..." ' of " & strCodeAB & " ..."
'Start looping the news row
strNewsID = arrValue(i, 1) 'Worksheets(strWsName).Range(ColRefNewsID & i).Value
If strNewsID = "" Then
Debug.Print i - 1 & " news is updated to database"
i = UBound(arrValue, 1)
Else
strFilter = "fID='" & strNewsID & "'"
rs.Filter = strFilter
If rs.EOF Then
.AddNew 'create a new record
'add values to each field in the record
For j = 0 To UBound(arrTitle_ALL)
'20140814
strFieldValue = .Fields(arrAccessField(j))
strNewValue = arrValue(i, j)
If IsNull(strFieldValue) And strNewValue = "" Then
Else
.Fields(arrAccessField(j)) = arrValue(i, j) 'Worksheets(strWsName).Cells(i, j + 1).Value
End If
Next j
On Error Resume Next '***************
.Update 'stores the new record
On Error GoTo 0
iCounterNewsAdded = iCounterNewsAdded + 1
glcounterNewsAdded = iCounterNewsAdded
Else
It seems that the below post similar to my request but I don't know how to do so.
[reference]passing an Array as a Parameter to be used in a SQL Query using the "IN" Command
The post you mention (Using the IN() command) works in your WHERE clause but it is not valid for values. MySQL has no way to pass an array so you need to loop through your array and run multiple INSERT statements:
for y = 0 to ubound(arrValue,1)
cmd.Parameters.AddWithValue(#CID,arrValue(0,y))
cmd.Parameters.AddWithValue(#ctype,arrValue(1,y))
cmd.ExecuteNonQuery
next y
I have written some code for retrieving 3 seperate columns from my database, yet for some reason it isn't loading all of the records which result from my query.
Or well, at least it doesn't seem to do so.
Also, for some reason it won't show me a messagebox which should tell me howmany records have been read after the reader is closed.
Here's my code:
Public Class frmPlayerLocations
Dim str(2), loc As String
Dim xx, yy As Integer
Dim itm As ListViewItem
Private Sub frmPlayerLocations_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ListView1.Columns.Add("ID", 60, HorizontalAlignment.Left)
ListView1.Columns.Add("Name", 115, HorizontalAlignment.Left)
ListView1.Columns.Add("Approximate Location", 115, HorizontalAlignment.Left)
Dim qry = "SELECT profile.unique_id, profile.name, survivor.worldspace FROM profile, survivor WHERE survivor.unique_id = profile.unique_id AND survivor.is_dead = '0' ORDER BY profile.name"
Dim connection As MySqlConnection
connection = New MySqlConnection()
connection.ConnectionString = "Host=" & adminPanel.IP & ";port=" & adminPanel.port & ";user=" & adminPanel.username & ";password=" & adminPanel.password & ";database=" & adminPanel.DBname & ";"
connection.Open()
Dim cmd As New MySqlCommand(qry, connection)
Dim reader As MySqlDataReader = cmd.ExecuteReader()
Dim count As Integer = 0
While reader.Read()
count += 1
str(0) = reader.GetString(0)
str(1) = reader.GetString(1)
loc = reader.GetString(2)
loc = Mid(loc, loc.IndexOf(",") + 3)
xx = CInt(Replace(Mid(loc, 1, loc.IndexOf(",")), ".", ",", 1, -1, CompareMethod.Text))
xx = (xx / 10000)
loc = Mid(loc, loc.IndexOf(",") + 2)
yy = CInt(Replace(Mid(loc, 1, loc.IndexOf(",")), ".", ",", 1, -1, CompareMethod.Text))
yy = 152 - (yy / 10000)
If xx < 100 Then
If xx < 10 Then
loc = "00" & xx.ToString & " | "
Else
loc = "0" & xx.ToString & " | "
End If
Else : loc = xx.ToString & " | "
End If
If yy < 100 Then
If yy < 10 Then
loc &= "00" & yy.ToString
Else
loc &= "0" & yy.ToString
End If
Else : loc &= yy.ToString
End If
str(2) = loc
itm = New ListViewItem(str)
ListView1.Items.Add(itm)
End While
reader.Close()
connection.Close()
MessageBox.Show(count)
End Sub
End Class
Edit: I noticed that when calling the form twice in a row, the second time I do get this error:
An unhandled exception of type 'System.ArgumentException' occurred in Microsoft.VisualBasic.dll
Additional information: Argument 'Length' must be greater or equal to zero.
And it refers to this line of code:
yy = CInt(Replace(Mid(loc, 1, loc.IndexOf(",")), ".", ",", 1, -1, CompareMethod.Text))
Last but not least, the values which are used in that line of code:
loc "7.305e-04]]" String
yy 131 Integer
PS: This may be helpful: the values which are in survivor.worldspace are in this format initially:
[168,[1291.16,5343.54,0.27]]
If the message box is not being displayed then the most likely situation is that an exception is being thrown inside the while loop which is probably silently caught somewhere else.
Unfortunately there are just too many places where an exception might occur withing that while loop so it's hard to say from just looking at that code. It could be trying to cast a DBNull to string, or an index out of bounds, etc.
My suggestion is to either step through with the debugger and identify the offending line, or put a try catch inside the while loop and put a break-point inside the catch. That should give you information about what (and where) the exception is occurring is..
Based on your update it looks like the problem is the arguments passed to the Mid() functions. Based on your data it looks like you are attempting to get a sub-string of loc using the start index of 1 and the end index of -1 which is what loc.IndexOf(",") returns in that case because there is no , (comma) in loc.
You probably want to re-factor that code a bit.. In particular it looks like you are actually trying to replace . with , but doing it after your attempt to call Mid(). That seems to be your problem!