Hi Guys,
I am running a Access 2003 db from a shared folder(cant move it closer to root) multi user (max 15 users) all queries and such are on an Excel front end in VBA(nothing is accessed by the user from MS access).
Current records 45,000 - expected to max out @ 500,000
Current fields(Columns) - 20
I have run some bench tests on the most intense query with no users working and it runs 20 seconds this climbs to approx 500 - 600 seconds when users are logged in. I have read some info about keeping the connection open for each user but I don't understand this.
Declared publicly
In a ModuleCode:'//================================== db connection strings Public cn As New ADODB.Connection Public rs As New ADODB.Recordset
Query - Cut down version of the Query this basically reports what each user has done in each hour of the day.Code:Public Sub cCon(shtname As String) Set cn = New ADODB.Connection cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _ & Sheet1.TextBox20.Text & "\CD Invoic.mdb;Jet OLEDB:Database Password=*******;" Set rs = New ADODB.Recordset cn.Open End Sub
Code:Dim uRange As Integer Dim aRange As Integer Dim intHr As Integer Dim MinUpDate As Field Dim Count As Long Dim BenchMark As Double BenchMark = Timer Application.ScreenUpdating = False clearit1 (shtname) cCon (shtname) rs.Open "SELECT UserName FROM User_Lookup", cn, adOpenStatic, adLockReadOnly '//Get usernames for Capture list Sheet2.Range("H3").CopyFromRecordset rs uRange = rs.RecordCount rs.Close Set rs = Nothing rs.Open "SELECT UserName FROM User_Lookup", cn, adOpenStatic, adLockReadOnly '//Get usernames for paid list Sheet2.Range("H20").CopyFromRecordset rs rs.Close Set rs = Nothing For aRange = 0 To uRange - 1 '// PH captures ************ from 06:00 to 19:00 **************** rs.Open "SELECT ID FROM Workflow WHERE Captured_By='" & Sheet2.Range("H" & aRange + 3).Value _ & "' AND Captured_Date BETWEEN #" & Format(Sheet2.ComboBox1.Text, "yyyy/mm/dd 06:00:00") & "# AND #" _ & Format(Sheet2.ComboBox1.Text, "yyyy/mm/dd 10:00:00") & "# AND TB_PB='PB'", cn, adOpenStatic, adLockReadOnly If Not rs.EOF Then rs.MoveFirst rs.MoveLast Sheet2.Range("I" & aRange + 3).Value = rs.RecordCount Else Sheet2.Range("I" & aRange + 3).Value = 0 End If rs.Close Set rs = Nothing Sheet2.Range("I" & "2").Value = Format("10:00:00") rs.Open "SELECT ID FROM Workflow WHERE Captured_By='" & Sheet2.Range("H" & aRange + 3).Value _ & "' AND Captured_Date BETWEEN #" & Format(Sheet2.ComboBox1.Text, "yyyy/mm/dd 10:00:01") & "# AND #" _ & Format(Sheet2.ComboBox1.Text, "yyyy/mm/dd 11:00:00") & "# AND TB_PB='PB", cn, adOpenStatic, adLockReadOnly If Not rs.EOF Then rs.MoveFirst rs.MoveLast Sheet2.Range("J" & aRange + 3).Value = rs.RecordCount Else Sheet2.Range("J" & aRange + 3).Value = 0 End If rs.Close Set rs = Nothing Sheet2.Range("J" & "2").Value = Format("11:00:00") rs.Open "SELECT ID FROM Workflow WHERE Captured_By='" & Sheet2.Range("H" & aRange + 3).Value _ & "' AND Captured_Date BETWEEN #" & Format(Sheet2.ComboBox1.Text, "yyyy/mm/dd 11:00:01") & "# AND #" _ & Format(Sheet2.ComboBox1.Text, "yyyy/mm/dd 12:00:00") & "# AND TB_PB='PB'", cn, adOpenStatic, adLockReadOnly If Not rs.EOF Then rs.MoveFirst rs.MoveLast Sheet2.Range("K" & aRange + 3).Value = rs.RecordCount Else Sheet2.Range("K" & aRange + 3).Value = 0 End If rs.Close Set rs = Nothing Sheet2.Range("K" & "2").Value = Format("12:00:00") rs.Open "SELECT ID FROM Workflow WHERE Captured_By='" & Sheet2.Range("H" & aRange + 3).Value _ & "' AND Captured_Date BETWEEN #" & Format(Sheet2.ComboBox1.Text, "yyyy/mm/dd 12:00:01") & "# AND #" _ & Format(Sheet2.ComboBox1.Text, "yyyy/mm/dd 13:00:00") & "# AND TB_PB='PB", cn, adOpenStatic, adLockReadOnly If Not rs.EOF Then rs.MoveFirst rs.MoveLast Sheet2.Range("L" & aRange + 3).Value = rs.RecordCount Else Sheet2.Range("L" & aRange + 3).Value = 0 End If rs.Close Set rs = Nothing Sheet2.Range("L" & "2").Value = Format("13:00:00") rs.Open "SELECT ID FROM Workflow WHERE Captured_By='" & Sheet2.Range("H" & aRange + 3).Value _ & "' AND Captured_Date BETWEEN #" & Format(Sheet2.ComboBox1.Text, "yyyy/mm/dd 13:00:01") & "# AND #" _ & Format(Sheet2.ComboBox1.Text, "yyyy/mm/dd 14:00:00") & "# AND TB_PB='PB", cn, adOpenStatic, adLockReadOnly If Not rs.EOF Then rs.MoveFirst rs.MoveLast Sheet2.Range("M" & aRange + 3).Value = rs.RecordCount Else Sheet2.Range("M" & aRange + 3).Value = 0 End If rs.Close Set rs = Nothing Sheet2.Range("M" & "2").Value = Format("14:00:00") MsgBox Round(Timer - BenchMark, 2) Application.ScreenUpdating = True rscnClean (shtname)
I compared this but didn't see any significant improvement.
Any help would be gladly appreciated.Code:rs.Open "SELECT Count (*) As tbC FROM Workflow WHERE Captured_By='" & Sheet2.Range("H" & aRange + 3).Value _ & "' AND Captured_Date BETWEEN #" & Format(Sheet2.ComboBox1.Text, "yyyy/mm/dd 13:00:01") & "# AND #" _ & Format(Sheet2.ComboBox1.Text, "yyyy/mm/dd 14:00:00") & "# AND TB_PB='PB", cn, adOpenStatic, adLockReadOnly If Not rs.EOF Then Sheet2.Range("M" & aRange + 3).Value = rs("tbC").Value End If rs.Close Set rs = Nothing Sheet2.Range("M" & "2").Value = Format("14:00:00")




Reply With Quote