Hi everybody.
Im making a system, which shows some incoming cases. The problem i have, is that I'm repeatedly running a sub, with 5 seconds interval.
What i do is connect to database (Access), get data if more posts than last, populate listbox and close objects.
My Listbox population is done, with a class module, which makes scroll bars to the listbox, if needed.
I've tried to make a step into to see, if i could see where the problem is, but I'm lost.
The function that I look through looks like this :
The LBHS.AddItem is derived from this class function :
My delay, looks like this :
When i make a step into, it'll repeat the ListSager() until it get's stack overflow, or VB just crashes, and shut's down.
For now, i'll keep on working, with the projekt, without the loop.. But I have to find a solution, or your solution
If anyone can see, what eats the memmory, I'll be so happy
Chers
Dennis
Machine code Rocks
Im making a system, which shows some incoming cases. The problem i have, is that I'm repeatedly running a sub, with 5 seconds interval.
What i do is connect to database (Access), get data if more posts than last, populate listbox and close objects.
My Listbox population is done, with a class module, which makes scroll bars to the listbox, if needed.
I've tried to make a step into to see, if i could see where the problem is, but I'm lost.
The function that I look through looks like this :
Code:
Sub ListSager()
Dim MyConn As New ADODB.Connection
Dim RSSag As New ADODB.Recordset
Dim RSAntal As New ADODB.Recordset
Dim ConnString As String
ConnString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DB\CS-SupportDB.mdb;User Id=admin;Password=;"
MyConn.ConnectionString = ConnString
MyConn.Open
SQLFindAntalSagerQuery = "SELECT COUNT(*) As SagsAntal FROM SagsTB WHERE Afviklet = false"
Set RSAntal = MyConn.Execute(SQLFindAntalSagerQuery)
If RSAntal("SagsAntal") > lblSagsAntal.Caption Then
lstSagsList.Clear
SQLFIndSagsInfoQuery = "SELECT Sag.SagsId, Sag.Dato, Sup.SupportType, MedArb.Navne, Sag.ProblemBeskrivelse FROM SagsTB Sag, SupportTypeTB Sup, MedarbejderTB MedArb WHERE Sag.SupportId = Sup.SupportId AND Sag.MedarbejderId = MedArb.MedarbejderId AND Sag.Afviklet = false"
Set RSSag = MyConn.Execute(SQLFIndSagsInfoQuery)
Do While Not (RSSag.BOF Or RSSag.EOF)
LBHS.AddItemTab RSSag("SagsId") & _
vbTab & RSSag("Dato") & _
vbTab & RSSag("SupportType") & _
vbTab & RSSag("Navne") & _
vbTab & RSSag("ProblemBeskrivelse")
RSSag.MoveNext
Loop
lblSagsAntal.Caption = RSAntal("SagsAntal")
End If
strInfo = "Info : " & RSAntal("SagsAntal") & " uafviklet sager"
lblInfo.Caption = strInfo
MyConn.Close
Set MyConn = Nothing
Set RSSag = Nothing
Set RSAntal = Nothing
Delay (5)
If CallAgain = True Then
ListSager
End If
End Sub
The LBHS.AddItem is derived from this class function :
Code:
Public Sub AddItemTab(ByRef psItemText As String)
Dim m As Long
Dim hdc As Long
Dim rc As RECT
Dim hOldFont As Long
Dim bHasVScrBar As Boolean
mvarListBox.AddItem psItemText
' --- calculating the width of the currently added item ---
hdc = GetDC(m_ListBoxHwnd) ' retrieving HDC for the listbox
hOldFont = SelectObject(hdc, m_hItemFont) ' selecting the required font
' if you specify the DT_CALCRECT flag,
' DrawText only Determines the width and height of the rectangle
' required to display the text:
DrawText hdc, psItemText, -1, rc, DT_SINGLELINE + DT_CALCRECT
m = rc.Right - rc.Left + 150
' restoring the previous state
Call SelectObject(hdc, hOldFont)
ReleaseDC m_ListBoxHwnd, hdc
' --- determining whether we need to display the horizontal scroll bar ---
If m > m_lMaxItemWidth Then
m_lMaxItemWidth = m
bHasVScrBar = GetWindowLong(m_ListBoxHwnd, GWL_STYLE) And WS_VSCROLL
SendMessageByLong m_ListBoxHwnd, LB_SETHORIZONTALEXTENT, _
m + IIf(bHasVScrBar, GetSystemMetrics(SM_CXVSCROLL), 4), 0
End If
' --- scrolling the listbox to be sure that the user see the last item ---
SendMessageByLong m_ListBoxHwnd, WM_VSCROLL, SB_BOTTOM, 0
End Sub
My delay, looks like this :
Code:
Public Sub Delay(lngSeconds As Long)
Dim lngStart As Long
Dim intstart As Integer
lngStart = Timer
Do While Timer <= lngStart + lngSeconds
DoEvents
If CallAgain = False Then
Exit Do
End If
Loop
Set Timer = Nothing
End Sub
When i make a step into, it'll repeat the ListSager() until it get's stack overflow, or VB just crashes, and shut's down.
For now, i'll keep on working, with the projekt, without the loop.. But I have to find a solution, or your solution
If anyone can see, what eats the memmory, I'll be so happy
Chers
Dennis
Machine code Rocks