Measuring query processing time in Microsoft Access - ms-access

I got this code for measuring the time of a query in Access database. Every time I try to run it, I get syntax error and MyTest() line is highlighted.
Option Compare Database
Option Explicit
Private Declare Function timeGetTime _
Lib "winmm.dll" () As Long
Private mlngStartTime As Long
Private Function ElapsedTime() As Long
ElapsedTime = timeGetTime() - mlngStartTime
End Function
Private Sub StartTime()
mlngStartTime = timeGetTime()
End Sub
Public Function MyTest()
Call StartTime
DoCmd.OpenQuery "Query1"
DoCmd.GoToRecord acDataQuery, "Query1", acLast
Debug.Print ElapsedTime() & _
Call StartTime
DoCmd.OpenQuery "Query2"
DoCmd.GoToRecord acDataQuery, "Query2", acLast
Debug.Print ElapsedTime() & _
End Function

Here's another alternative (old VB6/VBA - not VB.Net syntax).
KEY SUGGESTION: the "_" characters are "continuation lines". I honestly don't think you want them in most of the places you're using them.
IMHO...
Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private startTime, endTime As Long
Private Function elapsedTime(t1, t2 As Long) As Long
elapsedTime = t2 - t1
End Function
Public Function MyTest()
startTime = Now
' << do stuff >>
endTime = Now
MsgBox "Elapsed time=" & elapsedTime(startTime, endTime)
End Function
Private Sub Command1_Click()
Call MyTest
End Sub
edited.

In the two lines
Debug.Print ElapsedTime() & _
you are using the string concatenation character & and the line continuation character _ at the end of the line, even though the statement does not continue on the next line. So, either
continue the statement on the next line, e.g.
Debug.Print ElapsedTime() & _
" milliseconds" ' or whatever unit is returned by your ElapsedTime call
or
Remove the unneeded code:
Debug.Print ElapsedTime()
PS: Welcome to StackOverflow. Please get a good book on VBA development and read it. It's ok to ask basic questions here, but "please fix this code I found, because I don't know the basics of the language and don't have the time to learn it" type of questions are frowned upon and likely to be closed.

Related

How can I display Access report in ac.preview view when rest of Access screen has been hidden?

I have a database and when it opens code runs which hides everything in Access apart from a form.
This looks great for the user but I believe this is preventing me from displaying Reports in acViewPreview view.
If I prevent the On Load code from running then I am able to view reports in acViewPreview view.
I do not fully understand the code that hides everything on the form On Load event (I copied it years ago and it worked but I cannot recall from where so cannot credit the actual creator).
The code that hides Access:
Private Sub Form_Load()
Call fSetAccessWindow(0)
End Sub
Option Compare Database
Option Explicit
Global Const SW_HIDE = 0
Global Const SW_SHOWNORMAL = 1
Global Const SW_SHOWMINIMIZED = 2
Global Const SW_SHOWMAXIMIZED = 3
Private Declare Function apiShowWindow Lib "user32" _
Alias "ShowWindow" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Function fSetAccessWindow(nCmdShow As Long)
Dim loX As Long
Dim loForm As Form
On Error Resume Next
Set loForm = Screen.ActiveForm
If Err <> 0 Then
loX = apiShowWindow(hWndAccessApp, nCmdShow)
Err.Clear
End If
If nCmdShow = SW_SHOWMINIMIZED And loForm.Modal = True Then
MsgBox "Cannot minimize Access with " _
& (loForm.Caption + " ") _
& "form on screen"
ElseIf nCmdShow = SW_HIDE And loForm.PopUp <> True Then
MsgBox "Cannot hide Access with " _
& (loForm.Caption + " ") _
& "form on screen"
Else
loX = apiShowWindow(hWndAccessApp, nCmdShow)
End If
fSetAccessWindow = (loX <> 0)
End Function
How do I either temporarily reverse/disable the On Load code but only when a Report is run or perhaps there is an alternative way of viewing the Report that would work whilst Access is hidden by the On Load code?
Comment out the code line (the single-quote) to prevent the call of the function:
Private Sub Form_Load()
' Call fSetAccessWindow(0)
End Sub
or call it to "show the window normal":
Private Sub Form_Load()
Call fSetAccessWindow(1)
End Sub

Timer Routine to Auto close database doesn't always kick off

I have a routine that works perfectly as long as the timer routine kicks off. If it doesn't start, nothing happens.
A Hidden form called frm_Invisible gets loaded when my main form opens. My main form is a typical main form with buttons that open other forms. It's not a switchboard. I used to call frm_Invisible in the On Load event and not sure if it has made any difference but right now I put the call in the On Open event.
The frmMain calls it like this:
Private Sub Form_Open(Cancel As Integer)
DoCmd.OpenForm "frm_Invisible", acNormal, , , , acHidden
End Sub
frm_Invisible has an On Timer event:
Private Sub Form_Timer()
Static OldControlName As String
Static OldFormName As String
Static ExpiredTime
Dim ActiveControlName As String
Dim ActiveFormName As String
Dim ExpiredMinutes
Dim CountDown
On Error Resume Next
ActiveControlName = Screen.ActiveControl.Name
ActiveFormName = Screen.ActiveForm.Name
Me.txtActiveForm = ActiveFormName
If (OldControlName = "") Or (OldFormName = "") _
Or (ActiveFormName <> OldFormName) _
Or (ActiveControlName <> OldControlName) Then
OldControlName = ActiveControlName
OldFormName = ActiveFormName
ExpiredTime = 0
Else
ExpiredTime = ExpiredTime + Me.TimerInterval
End If
'Timer interval is set to 1000 which is equal to 1 second
'for testing, you can remove the /60 and make ExpiredMinutes happen a lot faster
'otherwise, keep the /60 and it will truly be whatever you set at the end
ExpiredMinutes = (ExpiredTime / 1000) / 60
Me.txtIdleTime = ExpiredMinutes
Form_frmMain.txtExpiredMinutes = ExpiredMinutes
If ExpiredMinutes >= 3 Then ' Can change this to 3 if you remove the '/60
'Opening this form will trigger the final count down
DoCmd.OpenForm "frmAutoClose"
End If
End Sub
If the time runs out I open a 3rd form that counts down from 20, giving the user a chance to keep the database open.
It merely counts down from 20 and runs
DoCmd.quit
unless the user clicks a button before the count down finishes. That button just closes the 3rd form, preventing the database from closing.
To test the routine, I put a textbox on frmMain, so that I could monitor if the timer gets kicked off.
Form_frmMain.txtExpiredMinutes = ExpiredMinutes
Most of the time, it does and I can see the time counting. However, there are instances that I cannot account for why the timer doesn't start. So I haven't published this latest update for my users.
I can just give you some general advice for now:
You should kick out On Error Resume Next to see if there maybe occures any error.
Later on you should add 'correct' error handling.
Add a type to this variables: ExpiredTime and ExpiredMinutes. Maybe Long?
Variable CountDown isn't used at all.
To prevent overflows you could directly store seconds instead of milliseconds in your variable ExpiredTime.
Then see what happens.
Update:
Since it can happen in your scenario that no form and therefore no control can be active, I would create two procedures to retrieve that information.
Both just return an empty string in case error 2474/2475 occurs.
Public Function GetActiveFormName() As String
On Error GoTo Catch
GetActiveFormName = Screen.ActiveForm.Name
Done:
Exit Function
Catch:
If Err.Number <> 2475 Then
MsgBox Err.Number & ": " & Err.Description, vbExclamation, "GetActiveFormName()"
End If
Resume Done
End Function
Public Function GetActiveControlName() As String
On Error GoTo Catch
GetActiveControlName = Screen.ActiveControl.Name
Done:
Exit Function
Catch:
If Err.Number <> 2474 Then
MsgBox Err.Number & ": " & Err.Description, vbExclamation, "GetActiveFormName()"
End If
Resume Done
End Function

How do I use a variable from a different function in another function?

I have one method
Public CurrentFileNameNoExtension As String
Public Sub importexcelfile()
CurrentFileNameNoExtension ="Filename"
'do something
End Sub
I want to use CurrentFileNameNoExtension value in onEnter event of the dropdown list(cmvalues) event. That Value use in sql query. My code is
Private Sub cmvalues_Enter()
Dim qstng As String
qstng = CurrentFileNameNoExtension
Me.cmvalues.RowSourceType = "Table/Query"
Me.cmvalues.RowSource = "Select F1 from " & qstng & " WHERE F1 <> 'Control Model';"
End Sub
But qstng value is empty. it is not giving the value in the importexcelfile() function.
EDIT: As I've just noticed, thanks to #simoco, that this is indeed for a userform, there are actually a couple of things to pull this off. One is using globals, which is quite tricky, and another is to use a function to get the string you want.
Function CurrentFileNameNoExtension() As String
'Do some FSO or GetOpenFileName here.
CurrentFileNameNoExtension = "Filename"
End Sub
Private Sub cmvalues_Enter()
qstng = CurrentFileNameNoExtension
Me.cmvalues.RowSourceType = "Table/Query"
Me.cmvalues.RowSource = "Select F1 from " & strFileName & " WHERE F1 <> 'Control Model';"
End Sub
There is not much of an issue using the code you have, really. You just have to make sure that the first sub is called before the second one so that cmvalues_Enter has a valid string to process.
Place this function under Microsoft Access Class Objects Form control,Where cmvalues dropdown exists
Public CurrentFileNameNoExtension As String
Public Sub importexcelfile()
CurrentFileNameNoExtension ="Filename"
'do something
End Sub

database search via username

I'm developing a call log system, and for tracking purposes the manager wants each user to be logged in upon entry.
I have a module that displays the current logged on user with the code below. I would like for the system to search the table "TBL_Users" for the username and in the text boxes display all the information pertinent to that username. Should that user not be in the database i need to display an error and not allow the user to progress into the system. I'm aware i may need to use a Dlookup but I'm unsure how to code this.
Option Compare Database
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
After playing around with Dlookup for a while, I need the text-boxes to populate on form load. This is the Dlookup i used.
Private Sub Form_Load()
Windows_Logontxt = fOSUserName()
'agentname = DLookup("Agent_Name", "TBL_Users", "Windows_Logon=" & Windows_Logontxt)
End Sub
It seems Windows_Logon and Windows_Logontxt are text values, so enclose Windows_Logontxt in quotes when you create the string for the third argument to DLookup.
DLookup("Agent_Name", "TBL_Users", "Windows_Logon='" & Windows_Logontxt & "'")

Forms GotFocus event does not seem to fire

I'm trying to call an event when the user returns focus to the Access application when a specific form is open. The following event doesn't seem to fire up at all.
Private Sub Form_GotFocus()
Call crtListDirectory
End Sub
Does any body have any ideas as to how I could trigger this event to happen, and when/how does the Form_GotFocus event actually get triggered.
thanks in advance for any help
Noel
Access help:
A form can get the focus only if all
visible controls on a form are
disabled, or there are no controls on
the form.
You might like to try Activate.
EDIT re Comments
The only way I can see of doing what you seem to want is with APIs, which is somewhat messy. To demonstrate this you will need a form with two controls Text0 and Text2 (these are the default names). Set the Timer Interval to something suitable, say 2000, and the Timer Event to:
Private Sub Form_Timer()
Dim lngWin As Long
Dim s As String
'This is just a counter to show that the code is running
Me.Text2 = Nz(Me.Text2, 0) + 1
'API
lngWin = GetActiveWindow()
s = GetWinName(lngWin)
If s = "Microsoft Access" Then
If Me.Text0 = "Lost Focus" Then
Me.Text0 = "Focus returned"
End If
Else
Me.Text0 = "Lost Focus"
End If
End Sub
You will now need a module for:
Option Compare Database
Declare Function GetActiveWindow Lib "user32" () As Integer
Declare Function GetWindowText Lib "user32.dll" Alias _
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As _
String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias _
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Function GetWinName(hw As Long)
Dim lngText As Long ' receives length of text of title bar
Dim strWinName As String ' receives the text of the title bar
Dim lngWinText As Long ' receives the length of the returned string
lngText = GetWindowTextLength(hw)
strWinName = Space(lngText + 1)
lngWinText = GetWindowText(hw, strWinName, lngText + 1)
strWinName = Left(strWinName, lngWinText)
GetWinName = strWinName
End Function
This is all very, very rough, but it gives you something to mess about with.