records retreive extremely slow

hello,i have problem with running really slow when it is retreaving records from table to display only the records I need. I am using access (.mdb) for my database and I use ADO to connect to the database on visual basic .most of the time my computer will hang when i retreaving data and my computer will become extremely slow until i need to restart computer.Does anyone know how to go about making data retreaval more efficient or faster, either through tweaking my code or tweaking the db itself using MS Access ?please help Thanks!

VB Code:

Private m_rs As ADODB.Recordset  ' Recordset tool
 
Private Sub CmdAdd_Click(Index As Integer)
    On Error Resume Next
    With m_rs
        .Fields("Location") = ComboLocation.Text
        .Fields("DatePurchase") = DTPpurchase
        .Fields("Item") = ComboItem.Text
        .Fields("Detail") = Txtitem2.Text
        .Fields("IDNumber") = Txtidnumber.Text
        .Fields("Price") = Txtprice.Text
        .Fields("Status") = Combostatus.Text
        .Fields("DateScrap") = DTPScrap
        .Update
        Call clear
        MsgBox "Record Saved", vbInformation, "Record is Saved"
        'End If
    End With
End Sub
'Delete Record
Private Sub cmddelete_Click(Index As Integer)
    On Error Resume Next
    With m_rs
        .Fields("Location") = ComboLocation.Text
        .Fields("DatePurchase") = DTPpurchase
        .Fields("Item") = ComboItem.Text
        .Fields("Detail") = Txtitem2.Text
        .Fields("IDNumber") = Txtidnumber.Text
        .Fields("Price") = Txtprice.Text
        .Fields("Status") = Combostatus.Text
        .Fields("DateScrap") = DTPScrap
        .Fields("Deletedate") = Txtdeldate.Text
        Call clear
        If MsgBox("Are you sure you wan't to delete record", vbOKCancel + vbExclamation, "Deleting Record") = vbOK Then
            .Update
            Call display1
        End If
    End With
End Sub
 
Private Sub Cmdnew_Click(Index As Integer)
    On Error Resume Next
    Call clear
    m_rs.AddNew
    Txtlocation.SetFocus
 
End Sub
Private Sub ComboItem_Click()
Dim imageName As String
    Picture1.Picture = LoadPicture()
    imageName = "D:\Tool Inventory v8.6\photo\" & ComboItem.Text & ".jpg"
    If Dir$(imageName) <> "" Then
        Picture1.Picture = LoadPicture(imageName)
    Else
        Picture1.Picture = LoadPicture()
    End If
End Sub
 
Private Sub Datagrid1_Click()
 Dim imageName As String
     DataGrid1.SetFocus
    DataGrid1.MarqueeStyle = dbgHighlightRow
    If Len(DataGrid1.Columns(1)) = 0 Then
        DTPpurchase.Enabled = False
    Else
        DTPpurchase.Enabled = True
        DTPpurchase.Value = DataGrid1.Columns(1)
    End If
    If Len(DataGrid1.Columns(7)) = 0 Then
        DTPScrap.Enabled = False
    Else
        DTPScrap.Enabled = True
        DTPScrap.Value = DataGrid1.Columns(7)
    End If
    ComboLocation.Text = DataGrid1.Columns(0)
    ComboItem.Text = DataGrid1.Columns(2)
    Txtitem2.Text = DataGrid1.Columns(3)
    Txtidnumber.Text = DataGrid1.Columns(4)
    Txtprice.Text = DataGrid1.Columns(5)
    Combostatus.Text = DataGrid1.Columns(6)
    DataGrid1.Refresh
    
    Picture1.Picture = LoadPicture()
    imageName = App.Path & "\photo\" & ComboItem.Text & ".jpg"
    If Dir$(imageName) <> "" Then
        Picture1.Picture = LoadPicture(imageName)
    Else
        Picture1.Picture = LoadPicture()
    End If
 
End Sub
Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
'row down
  Dim imageName As String
     DataGrid1.SetFocus
    DataGrid1.MarqueeStyle = dbgHighlightRow
    If Len(DataGrid1.Columns(1)) = 0 Then
        DTPpurchase.Enabled = False
    Else
        DTPpurchase.Enabled = True
        DTPpurchase.Value = DataGrid1.Columns(1)
    End If
    If Len(DataGrid1.Columns(7)) = 0 Then
        DTPScrap.Enabled = False
    Else
        DTPScrap.Enabled = True
        DTPScrap.Value = DataGrid1.Columns(7)
    End If
    ComboLocation.Text = DataGrid1.Columns(0)
    ComboItem.Text = DataGrid1.Columns(2)
    Txtitem2.Text = DataGrid1.Columns(3)
    Txtidnumber.Text = DataGrid1.Columns(4)
    Txtprice.Text = DataGrid1.Columns(5)
    Combostatus.Text = DataGrid1.Columns(6)
    DataGrid1.Refresh
    
    Picture1.Picture = LoadPicture()
    imageName = App.Path & "\photo\" & ComboItem.Text & ".jpg"
    If Dir$(imageName) <> "" Then
        Picture1.Picture = LoadPicture(imageName)
    Else
        Picture1.Picture = LoadPicture()
    End If
 
 
End Sub
Private Sub Form_Load()
    Dim rs1 As ADODB.Recordset
    Dim rs2 As ADODB.Recordset
 
    'sql query login user department
   Set m_rs = OpenRecordset("select * from [Inventory]" & vbCrLf & _
                            "where ([Location] in (" & vbCrLf & _
                            "  select [DepartmentName] from [Department]" & vbCrLf & _
                            "  where [Id] in (" & vbCrLf & _
                            "    select [DepartmentID] from [UserDepartment]" & vbCrLf & _
                            "    where [UserId] = '" & gUserId & "'" & vbCrLf & _
                            "  )" & vbCrLf & _
                            ") or exists(SELECT * FROM UserRoles WHERE [UserId] = " & gUserId & _
                            " and [RoleId] in (select [Id] from [Roles] where [RoleName] = 'admin')))" & _
                            " and Deletedate is null", adOpenStatic, adLockOptimistic)
    Set DataGrid1.DataSource = m_rs
    Debug.Print "Connection Object Created"
    
    'stutus list
    Combostatus.AddItem "Active"
    Combostatus.AddItem "Relocate"
    Combostatus.AddItem "Spoilt"
    
'If Not IsNull(m_rs!Location) Then
 ' ComboLocation.Text = m_rs!Location
'End If
 
'If Not IsNull(m_rs!Item) Then
 ' ComboItem.Text = m_rs!Item
'End If
 
Set rs1 = OpenRecordset("select distinct Location From Inventory", adOpenStatic, adLockReadOnly)
   While Not rs1.EOF
            ComboLocation.AddItem rs1!Location
            rs1.MoveNext
        Wend
        rs1.Close
Set rs1 = Nothing
 
Set rs2 = OpenRecordset("select distinct Item From Inventory", adOpenStatic, adLockReadOnly)
   While Not rs2.EOF
            ComboItem.AddItem rs2!Item
            rs2.MoveNext
        Wend
        rs2.Close
Set rs2 = Nothing
    
    'Text1.Text = "Database Record " & "_" & m_rs.RecordCount
    Txtdeldate.Text = Format(Now, "dd/mm/yyyy")
End Sub
 
Private Sub CmdExit_Click()
    Unload Me
End Sub
Private Sub cmdSave_Click()
    ' This button will save the changes and additions
    With m_rs
        ' If our Textboxes not empty
        If Txtlocation.Text <> "" And Txtdateofpurchase.Text <> "" _
                And Txtitem1.Text <> "" And Txtitem2.Text And Txidnumber.Text <> "" _
                And Txtprice.Text <> "" And Txstatus.Text <> "" And Txtdateofscrap.Text Then
            ' Put the content of our textboxes in the current
            ' recordset
            .Fields("Location") = ComboLocation.Text
            .Fields("Date Of Purchase") = Txtdateofpurchase.Text
            .Fields("Item") = ComboItem.Text
            .Fields("Detail") = Txtitem2.Text
            .Fields("ID Number") = Txtidnumber.Text
            .Fields("Price") = Txtprice.Text
            .Fields("Status") = Txtstatus.Text
            .Fields("Date Of Scrap") = Txtdateofscrap.Text
            .Update
        End If
    End With
    ' Ready, now we're able to change our data
End Sub

How many records are you trying to retrieve?

When doing a Select query, specify the field name not *. Well, in some case you need to and try to avoid using On Error Resume Next if necessary. It will be easier to debug.

zynder:
The records is about 6000.

Try changing this

VB Code:

With m_rs
        .Fields("Location") = ComboLocation.Text
        .Fields("DatePurchase") = DTPpurchase
        .Fields("Item") = ComboItem.Text
        .Fields("Detail") = Txtitem2.Text
        .Fields("IDNumber") = Txtidnumber.Text
        .Fields("Price") = Txtprice.Text
        .Fields("Status") = Combostatus.Text
        .Fields("DateScrap") = DTPScrap
        .Update
End With

to this

VB Code:

With m_rs
        .Fields("Location").Value = ComboLocation.Text
        .Fields("DatePurchase").Value = DTPpurchase
        .Fields("Item").Value = ComboItem.Text
        .Fields("Detail").Value = Txtitem2.Text
        .Fields("IDNumber").Value = Txtidnumber.Text
        .Fields("Price").Value = Txtprice.Text
        .Fields("Status").Value = Combostatus.Text
        .Fields("DateScrap").Value = DTPScrap
        .Update
End With

Then add some doevents while populating your controls.

zynder:
not much improve for the retreive speed.

As a side note, I'd ditch those 'On Error Resume Next' statements in the Add and Delete Subs. You aren't doing anything that should cause you to have to Resume next per se (use On Error Goto xxxx).

bruce fox:
i has try your method to use 'On Error Resume Next' statements in the Add and Delete Subs.but the problem still remind the same...extremely slow until computer and need to reboot agian.

Ok here's what you need to do. Remove all On Error Resume Next and see if there's an error.

If there is, then post the offending line of code. In my opinion, there must be an error on your coding but since you have that Resume Next, chances are you won't find the error and be impossible to debugged.

If they're properly coded, even if you load more than 6,000 records say 30k plus, it'll not get to the point of system freeze. There must be something in there that you can't find.

zynder:
i has try to remove all the "on error resume next",but the problem is still remain the same. what can i do now?please help.Thanks!

if you run your program continuously does it just get slower? or is it if you keep restarting it?

do you have code in your form unload or form query unload events?

westconn1:
once i run project to retrieve record my computer will get extremely slow until hang for few sec and i need to reboot agian to gain back to normal speed.ya ,from database have database query events.

Is the database on your pc or on a network? If it's on a network can you copy it to your pc and see if your program runs faster?

I've heard DAO is faster than ADO, I use DAO but that's just my preference.

davidbishton:
the database is on my pc and i using ADO.

Thread moved to correct forum.

As already mentioned above, specify your fields (instead of "Select *"), do not use "On Error Resume Next" (unless you have a good reason - which you certainly dont), and specify properties when working with objects (such as .Value for fields, and possibly for your date pickers too).


There are further improvements that can be made to the speed of your SQL statement, but we need to clean up your coding issues a bit first.


What is OpenRecordset? Presumably this is a function which you have written, and not shown.

What is gUserId? Presumably a global variable, but has it been set appropriately before the form loads? (note that in your main SQL statement, you dont have ' around it for the UserRoles part)

si_the_geek：
you are right the OpenRecordset written are not shown. gUserId is Id from database users table Id.At module1 you can see all the variable there.please guide i'm new in VB.Thanks!

We need to see the code for OpenRecordset, and how you get gUserID (is it set before this form loads?).

si_the_geek:
this is the code for OpenRecordset:

VB Code:

Public Function OpenRecordset(ByVal strsql As String, _
        Optional ByVal CursorType As CursorTypeEnum = CursorTypeEnum.adOpenForwardOnly, _
        Optional ByVal LockType As LockTypeEnum = LockTypeEnum.adLockReadOnly) As Recordset
    Dim rs As New Recordset
    If OpenConn Then 'aviod time ping out
        On Error GoTo TrackErr
        rs.Open strsql, conn, CursorType, LockType
    End If
    Set OpenRecordset = rs
    Exit Function
TrackErr:
    gErrDescription = Err.Description
    Err.clear
End Function

gUserID is get before this form loads at modules->module1.

This is Module1 code.Is load before the previous code i post.

VB Code:

Option Explicit
 
Public gErrDescription As String 'error message
Public gLogined As Boolean 'success login ?
Public gLoginName As String 'login name
Public gUserId As String 'login user id
Public gUsreName As String ' login user name
Public conn As Connection
 
'begin code
Public Sub Main()
    gLogined = False 'not yet login
    frmLogin.Show vbModal 'display login form
    If Not gLogined Then End    'login fail will end login screen
    frmMain.Show      'login success will load frmMain
End Sub
 
'connect database table
Private Function OpenConn() As Boolean
    If conn Is Nothing Then Set conn = New Connection
    With conn
        If .State = adStateClosed Then
            .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & _
                "\Tool.mdb;Persist Security Info=False"
            .CursorLocation = adUseClient
            On Error GoTo TrackErr
            .Open
        End If
        OpenConn = (.State = adStateOpen)
    End With
    Exit Function
TrackErr:
    gErrDescription = Err.Description
    Err.clear
End Function
 
Public Function ExecSql(ByVal strsql As String) As Boolean
    If OpenConn Then 'aviod time ping out
        On Error GoTo TrackErr
        conn.Execute strsql
        ExecSql = True
    End If
    Exit Function
TrackErr:
    gErrDescription = Err.Description
    Err.clear
End Function
 
Public Function QuerySql(ByVal strsql As String) As Recordset
    If OpenConn Then 'aviod time ping out
        On Error GoTo TrackErr
        Set QuerySql = conn.Execute(strsql)
    End If
    Exit Function
TrackErr:
    gErrDescription = Err.Description
    Err.clear
End Function
 
Public Function OpenRecordset(ByVal strsql As String, _
        Optional ByVal CursorType As CursorTypeEnum = CursorTypeEnum.adOpenForwardOnly, _
        Optional ByVal LockType As LockTypeEnum = LockTypeEnum.adLockReadOnly) As Recordset
    Dim rs As New Recordset
    If OpenConn Then 'aviod time ping out
        On Error GoTo TrackErr
        rs.Open strsql, conn, CursorType, LockType
    End If
    Set OpenRecordset = rs
    Exit Function
TrackErr:
    gErrDescription = Err.Description
    Err.clear
End Function
 
'close table connection
Public Sub CloseConn()
    If conn Is Nothing Then Exit Sub
    If conn.State = adStateClosed Then Exit Sub
    conn.Close
    Set conn = Nothing
End Sub
 
'User login
Public Function DoLogin(ByVal strName As String, ByVal strPwd As String) As Boolean
    Dim rs As Recordset, rows As Integer
    gUserId = vbNullString 'login is not success
    gLogined = False
    Set rs = QuerySql("select [Id], [UserName], [Pwd] from [Users] where [LoginName] like '" & strName & "'")
    If Not rs Is Nothing Then
        If rs.State = adStateOpen Then
            While Not rs.EOF
                rows = 1
                If strPwd = rs("Pwd") Then
                    gLoginName = strName 'login name
                    gUserId = rs("Id") 'login user idV
                    gUsreName = IIf(IsNull(rs("UserName")), "", rs("UserName")) 'user name
                    gLogined = True
                    DoLogin = True 'login is success
                End If
                rs.MoveNext
            Wend
            rs.Close
        End If
        If Not DoLogin Then gErrDescription = IIf(rows = 0, "User doesn't Exist£¡", "Invalid Password£¡")
    End If
    Set rs = Nothing
End Function
 
'check the authorize access
Public Function CheckRight(ByVal strModuleName As String) As Boolean
    Dim rs As New Recordset, vflag As Boolean
    Set rs = QuerySql("select [Availability] from vUserAllRight where [LoginName] like '" & gLoginName & _
            "' and [ModuleName] like '" & strModuleName & "'")
    If Not rs Is Nothing Then
        If rs.State = adStateOpen Then
            While Not rs.EOF
                vflag = vflag Or rs("Availability")
                rs.MoveNext
            Wend
            rs.Close
        End If
        CheckRight = vflag
    End If
    Set rs = Nothing
End Function
 
'check the Value is exists at table
Public Function CheckValueIsExists(ByVal TableName As String, _
        ByVal FieldName As String, ByVal strValue As String, _
        Optional ByVal strEliminate As String = vbNullString) As Boolean
    Dim rs As New Recordset, strsql As String
    strsql = "select count(*) as [RowCount] from [" & TableName & _
        "] where [" & FieldName & "] = '" & Replace(strValue, "'", "''") & "'"
    'at modify state, eliminate self
    If Len(strEliminate) > 0 Then strsql = strsql & " and [Id] <> " & strEliminate
    Set rs = QuerySql(strsql)
    If Not rs Is Nothing Then
        If rs.State = adStateOpen Then
            CheckValueIsExists = (rs("RowCount") > 0)
            rs.Close
        End If
    End If
End Function

Thanks!

You have 2 functions both named OpenRecordset?
Also, unless I missed it, where do you set rs to anything?

I think they both OpenRecordset's are the same one, just posted twice.

The setting of rs is done, but it is very dubious - it is done by "Dim As New" :eek2:
Instead it should be done with a Set, and you should clear it when possible (to avoid memory issues etc), eg:

VB Code:

..
    [U]Dim rs As Recordset  
    Set rs = New Recordset[/U]
    If OpenConn Then 'aviod time ping out
        On Error GoTo TrackErr
        rs.Open strsql, conn, CursorType, LockType
    End If
    Set OpenRecordset = rs
    [U]Set rs = Nothing[/U]
..

In Sub Main you have a very bad piece of code - a single word that should always be avoided, which is End. In this case you should replace it with Exit Sub (as the program ends safely when there is no more code to run, and no forms open), eg:

VB Code:

If Not gLogined Then Exit Sub

I assume frmLogin basically (after user input) just calls DoLogin, correct?

In several of your SQL statements you have used "like" instead of "=", is there a reason for that?

si_the_geek:
i has been try the method you mention above,but the problem still remain the same,records retreive extremely slow until computer hang need to reboot . :( ya, frmlogin is affert user input click Ok to login will calls Dologin and SQL statements used "like" instead of "=",am i used the wrong method?

below is frmlogin code:

VB Code:

Private Sub cmdOK_Click()
    'check corerct password to login
    If Not DoLogin(txtUserName.Text, txtPassword.Text) Then
        MsgBox "Please Enter Correct Password£¡" & gErrDescription, vbCritical, "Warning"
        Exit Sub
    End If
    Unload Me
End Sub

Thanks!

Try putting breakpoints in your code at the start of each module. See which ones you hit quickly. Then, when you don't hit the next one, you'll know the previous one is where your problem is.
Then step through the code in that module to see which line causes the delay.
This is kind of a brute force method to find the problem, but should work to identify it.

salvelinus:
i try your method to putting breakpoints at the start of each module.i found the speed run very slow at this module location.

VB Code:

Public Function OpenRecordset(ByVal strsql As String, _
        Optional ByVal CursorType As CursorTypeEnum = CursorTypeEnum.adOpenForwardOnly, _
        Optional ByVal LockType As LockTypeEnum = LockTypeEnum.adLockReadOnly) As Recordset
    Dim rs As New Recordset
    Set rs = New Recordset
    If OpenConn Then 'aviod time ping out
        On Error GoTo TrackErr
        rs.Open strsql, conn, CursorType, LockType
    End If
    Set OpenRecordset = rs
    Set rs = Nothing
    Exit Function
TrackErr:
    gErrDescription = Err.Description
    Err.clear
End Function

Thanks!

Ok, then when you get to that module, step through that code to see which line causes the problem. You can do that when you hit the breakpoint in that module by using the debug menu, or, I think, hitting F8. That will walk you through the code line by line.
The problem could be in OpenConn, since you call that. Stepping through will help with that.
Per Si above, also change the way you declare rs.

salvelinus:
i have try the F8 method go through the code line by line.i can't found any problem at this moment.now is run the first and second time retreive record will get faster,but third time login to retreive record it will back very slow. :( :( :(
help please!

Thanks!

Well, I'm going on vacation to Barbados, so probably can't work through this with you. But if it works ok first time, slows down later, you might want to look at memory resources.
First, obviously, is do you have enough memory on your machine for what you want to do? This isn't as big a problem as it used to be, but I still see machines with 32 mb memory trying to run more modern apps.
Second, do you close objects and Set them to Nothing - rs, etc - when you're done with them? If performance gets worse with each run, this would be a good place to look.
If it's not too large, and you're allowed to do it, you might want to zip up your db and post it here, so people can check it out.

salvelinus:
Gratitude your suggestion.my laptop memory is 1gb,so i think may not a problem to run the project.i will check agian the close object and Set them to Nothing.
by the way how to post the zip file here?

Thanks!

Yes, 1 gb of memory should work :)
To post an attachment, first zip your file using Winzip or whatever program you may have to zip files. Then when you click "Reply", towards the bottom of the screen (scroll if necessary) you'll see a section to "Attach Files" with a button "Manage Attachments"

this is my zip file.

re-upload database file.if the previous post database can't open,please refer to this database file.

username & password is same:
1)qc
2)production
3)autolathe

Thanks!

Okay so I've tried your project and see a lot of problems.

Memory Issues ( took more than 1G of memory )
You have to fix your code and be sure to Set your objects or recordset to Nothing. Binding a database is not of my choice.

VB Code:

Set m_rs = OpenRecordset("select * from [Inventory]" & vbCrLf & _
                            "where ([Location] in (" & vbCrLf & _
                            "  select [DepartmentName] from [Department]" & vbCrLf & _
                            "  where [Id] in (" & vbCrLf & _
                            "    select [DepartmentID] from [UserDepartment]" & vbCrLf & _
                            "    where [UserId] = '" & gUserId & "'" & vbCrLf & _
                            "  )" & vbCrLf & _
                            ") or exists(SELECT * FROM UserRoles WHERE [UserId] = " & gUserId & _
                            " and [RoleId] in (select [Id] from [Roles] where [RoleName] = 'admin')))" & _
                            " and Deletedate is null", adOpenStatic, adLockOptimistic)
    Set DataGrid1.DataSource = m_rs

You got to fix your query.

You also overlook some null values. you can add "" and .Value.

VB Code:

While Not rs.EOF
        total = total + rs("Price")[B].Value[/B] [B]& ""[/B]
        DataReport1.Sections("Section2").Controls.Item("Label9").Caption = rs("Location") '"Department:" & rs("Location")
        rs.MoveNext
    Wend

That's all I can help for now. I having difficulty debbuging it because it hangs after compiling. Maybe you got to consider memory issues.

Why do you need all those vbcrlf's in a SQL statement? It makes no sense to me.

Do you have any indexes set on your database?

VB Code:

Set m_rs = OpenRecordset("select * from [Inventory]" & vbCrLf & _
                            "where ([Location] in (" & vbCrLf & _
                            "  select [DepartmentName] from [Department]" & vbCrLf & _
                            "  where [Id] in (" & vbCrLf & _
                            "    select [DepartmentID] from [UserDepartment]" & vbCrLf & _
                            "    where [UserId] = '" & gUserId & "'" & vbCrLf & _
                            "  )" & vbCrLf & _
                            ") or exists(SELECT * FROM UserRoles WHERE [UserId] = " & gUserId & _
                            " and [RoleId] in (select [Id] from [Roles] where [RoleName] = 'admin')))" & _
                            " and Deletedate is null", adOpenStatic, adLockOptimistic)

randem is correct. Use the _ line break in your code for readability, but you don't actually have to line break your code.

randem,salvelinus:
you mean the code need to change to this way without the vbcrLf?from the database didn't set any indexes.

VB Code:

Set m_rs = OpenRecordset("select * from [Inventory]" & _
                            "where ([Location] in (" & _
                            "  select [DepartmentName] from [Department]" & _
                            "  where [Id] in (" & _
                            "    select [DepartmentID] from [UserDepartment]" & _
                            "    where [UserId] = '" & gUserId & "'" & _
                            "  )" & _
                            ") or exists(SELECT * FROM UserRoles WHERE [UserId] = " & gUserId & _
                            " and [RoleId] in (select [Id] from [Roles] where [RoleName] = 'admin')))" & _
                            " and Deletedate is null", adOpenStatic, adLockOptimistic)

Thanks!

If you don't have indexes your retrieval will be slow. This is also greatly affected by the type of data types that are indexed.

please help i has change the query code to this way,but the query statement ll contain some error....please help to correct the error.

VB Code:

Set m_rs = OpenRecordset(select * from Inventory 
                            where Location=(select (DepartmentName) 
                            from (Department)
                            where (Id) =(select (DepartmentID) from (UserDepartment)
                            where [UserId] = '" & gUserId & "'"& _" ))
                    or exists(SELECT * FROM UserRoles WHERE [UserId] = " & gUserId & _
                            and [RoleId] in (select [Id] from [Roles] where [RoleName] = 'admin')))" & _
                            and Deletedate is null", adOpenStatic, adLockOptimistic)
 
code

Thanks!

Some Errors????? You could help a lo by telling us what exactly the errors are...
Try doing this and your errors will be clear

VB Code:

SQL = "select * from Inventory 
                            where Location=(select (DepartmentName) 
                            from (Department)
                            where (Id) =(select (DepartmentID) from (UserDepartment)
                            where [UserId] = '" & gUserId & "'"))
                    or exists(SELECT * FROM UserRoles WHERE [UserId] = " & gUserId & _
                            and [RoleId] in (select [Id] from [Roles] where [RoleName] = 'admin')))" & _
                            and Deletedate is null")
 
Debug.Print SQL

I can't even log onto your system without system errors (Selected collating sequence not supported by the operating system).

BTW: Your database is designed all wrong. You use text fields for everything except date/time fields. Why do you use text fields for numbers? Indexing and searching will be horribly slow.

It will help if the items you use to select from are indexed and numeric fields. Lookup tables are ideal for this.

randem:
can't logon to the system?mean you can't even open the project file?
you mean using text fields for numbers will cause the system run very slow?so that the system keep hang? i has change the number to number field,but it seem not much improve.

Thanks!

Of course I can open the project file. You have a logon screen that fails when executing the statement to get the user information to check it.

The system running slow or appearing to hang can be a number of things...

You are in a loop, not allowing other events to be processed.
SQL doesn't use database indexes (or none exist).
Lots of text comparisons in SQL Query

randem:
i was set all the field to indexes.but the system run after 2-3 time it will getting slow until hang.

Only set indexes on the key fields you will be using...

Quote:

---

you mean using text fields for numbers will cause the system run very slow?so that the system keep hang? i has change the number to number field,but it seem not much improve.

---

Using text fields will slow things down (usually noticably - as you will see later in this post), and use more memory/increased file size than the equivalent numeric data type.

I notice that in several places you still have "Dim rs As New Recordset", which will be eating away at the memory too (you also do not always set them to Nothing afterwards, such as in CheckValueIsExists)

You also have ".CursorLocation = adUseClient", which is specifically asking for your program to take up more memory - as all of the data returned by queries is copied to your programs memory. Is there a reason for it to be there?



As to your SQL with errors, one major point is the lack of quotes & underscores to separate the lines, you also have several brackets you dont need (like around table/field names), and now that your fields are numeric you should remove the single quotes from around the UserId values.

This is how it should have been:

VB Code:

Set m_rs = OpenRecordset("select * from Inventory " & _
                            "where (Location=(select DepartmentName " & _
                            "from Department " & _
                            "where Id =(select DepartmentID from UserDepartment " & _
                            "where [UserId] = " & gUserId & " " & _
                            " ))  " & _
                            "or exists(SELECT * FROM UserRoles WHERE [UserId] = " & gUserId & " " _
                            "and [RoleId] in (select [Id] from [Roles] where [RoleName] = 'admin')))" & _
                            "and Deletedate is null", adOpenStatic, adLockOptimistic)

There is something very bad about this query tho - you are joining based on text (DepartmentName). This is something that should always be avoided if possible, as it is extremely slow.

By adding an extra column to the Inventory table for DepartmentID (which I called LocationID), and setting it to the relevant values by using an Update statement, the query becomes shorter as below:

VB Code:

"from Department " & _
                            "where (LocationID=(select DepartmentID from UserDepartment " & _
                            "where [UserId] = " & gUserId & " " & _
                            " )  " & _
                            "or exists(...

..and the time for this to run 'fully' inside Access dropped from over 40 seconds (for the previous version) to about 10 seconds.


I haven't looked properly at your code yet, as the memory issues were present in Access too.. most likely due to the sheer size of the data.

There are ways to reduce the data size significantly.. the first is the biggest, which is to add extra conditions to your Where clause to only return a portion of the data instead of all of it (eg: "and Deletedate is null AND [Item] = 'Block T1'").

You can also reduce the database size quite a bit with a little re-design (in the mdb file at least, may or may not affect the data returned by the query). The main way is to store ID numbers in the table instead of the text (so if the Department table contained all "Location" values, you could remove Location and just use the LocationID field). You could also create extra tables - with Status for example (as it has only 3 values). This would also help with data consistency, as people cannot mis-type values by mistake (they would simply select it from a list).

..I have no idea if doing this would work for you tho, as DataGrids apparently have big problems using joined tables.

si_the_geek:
i will try your suggestion....Thanks...will let you know the request:)

Private m_rs As ADODB.Recordset ' Recordset tool

Set m_rs = OpenRecordset("select * from Inventory " & _
"where (Location=(select DepartmentName " & _
"from Department " & _
"where Id =(select DepartmentID from UserDepartment " & _
"where [UserId] = " & gUserId & " " & _
" )) " & _
"or exists(SELECT * FROM UserRoles WHERE [UserId] = " & gUserId & " " _
"and [RoleId] in (select [Id] from [Roles] where [RoleName] = 'admin')))" & _
"and Deletedate is null", adOpenStatic, adLockOptimistic)

Public Function OpenRecordset(ByVal strsql As String, _
Optional ByVal CursorType As CursorTypeEnum = CursorTypeEnum.adOpenForwardOnly, _
Optional ByVal LockType As LockTypeEnum = LockTypeEnum.adLockReadOnly) As Recordset

You we're able to assign a DAO recordset to an ADO recordset???

IIRC there is no DAO, only ADO is used.

The name Recordset is used for objects in each library, but like many coders no library is specified in the declaration - so errors are likely if any other library (not just DAO) is added to the project. :(

I'd redesign the inventory interface, your just showing the same information in the textboxes and the list... also if you can reduce the number of columns and rows (don't return entire table) used by a recordset, such as using a tab control for dates (one tab per month in a year), etc then you can speed up retrieval since less data is returned.

Use INSERT, UPDATE, and DELETE SQL statements instead of the recordset methods... your loading entire table in order to add one record.... your loading entire table in order to update one record... your loading entire table to delete one record.

leinad31:
can you upload the redesign inventory project here??let see how you work with.thanks!

There are many ways to skin a cat... it depends mostly on what the important fields are (eg. what is usually used as criteria when a user searches for a record/records). Here's a sample (I focued on generating the output, did design shortcuts such as select *) that uses the treeview control to breakdown the dates in the database into years-months. I wasn't able to use your db (says its corrupted), just update the connection string and table, field names acordingly to fit your project.

There are samples in the forum on using insert, update and delete, try to do a search. The point I'm trying to make is don't try to work with the entire table... after all the user can view only several of themn at a time, and you can only have one current record at any given time. Best to get rid of the habit early... I saw a project a year ago where the programmer ended up loading the entire database into memory with several recordsets (for tables, joins, reports) that were never closed during program run... you can imagine what happened when we tried to run the app with several years worth of accounting data, took more than an hour for it just to load.

Oh and do the per row information display as one form or container (controls in form, in picturebox, frame). When the user will view/update/delete one record, you now have a reusable container which shows appropriate information based on primary key passed (it queries table returning just one record and updates the controls with values. You cal also pass other arguments to control which buttons (add, update, delete) are show in this form/container like what the message box does (eg. vbYesNo, vbOkCancel).