One can't get the staff these days.
We have a problem that a database program is left running minimised. If this
is not spotted, one of our staff is likely to click on the desltop icon and
open a secocond copy of the Db

This code run from the AutoExec Macro prevents it happeneing.

Public Function IsAlreadyRunning() As Integer

Dim DB As DAO.Database
Dim Msg As String

On Error GoTo PROC_ERR

Set DB = CurrentDb

If TestDDELink(DB.Name) Then
Msg = CurrentDb.Name & " is already open" & vbCrLf
Msg Msg = Msg & "Do you really want another instance of " & CurrentDb.Name &
" running?" If MsgBox(Msg, vbQuestion + vbYesNo + vbDefaultButton2) = vbNo
Then DB.Close
Set DB = Nothing
DoCmd.Quit
?????????????????
Else
fSetAccessWindow (SW_SHOWMAXIMIZED)
End If
End If

Exit Function

PROC_ERR:
MsgBox Err.Description
Resume Next

End Function

Function TestDDELink(ByVal strAppName$) As Integer

Dim varDDEChannel

On Error Resume Next

Application.SetOption ("Ignore DDE Requests"), True

varDDEChannel = DDEInitiate("MSAccess", strAppName)
' When the app isn't already running this will error

If Err Then
TestDDELink = False
Else
TestDDELink = True
DDETerminate varDDEChannel
DDETerminateAll
End If

Application.SetOption ("Ignore DDE Requests"), False

End Function


'************ Code Start **********
' This code was originally written by Dev Ashish.
' It is not to be altered or distributed,
' except as part of an application.
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Code Courtesy of
' Dev Ashish
'

Function fSetAccessWindow(nCmdShow As Long)

'Usage Examples
'Maximize window:
' ?fSetAccessWindow(SW_SHOWMAXIMIZED)
'Minimize window:
' ?fSetAccessWindow(SW_SHOWMINIMIZED)
'Hide window:
' ?fSetAccessWindow(SW_HIDE)
'Normal window:
' ?fSetAccessWindow(SW_SHOWNORMAL)
'
Dim loX As Long
Dim loForm As Form

On Error Resume Next
Set loForm = Screen.ActiveForm

If Err <> 0 Then 'no Activeform
If nCmdShow = SW_HIDE Then
MsgBox "Cannot hide Access unless a form is on screen"
Else
loX = apiShowWindow(hWndAccessApp, nCmdShow)
Err.Clear
End If
Else
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
End If

fSetAccessWindow = (loX <> 0)

End Function

Where the ??????? is in the code, I need it to maximize the database that is
already open. Guess it will be something to do with hwnd, but need help

Thanks

Phil

Hi Pil,

Why don't you force exclusive use of the db??
Check for IsCurDBExclusive() (Google for the code) and Quit

Arno R

"Phil" <phil (AT) stantonfamily (DOT) co.uk> schreef in bericht news:ibe32a$kut$1 (AT) speranza (DOT) aioe.org...

Try this kind of routine to get the handle of the other Access instance and
then use SendMessage with the SW_SHOWMAXIMIZED parameter to maximise it:

Dim lngX As Long
Dim lngStyle As Long, strCaption As String
lngX = GetDesktopWindow() 'Return the first child to Desktop
lngX = GetWindow(lngX, mcGWCHILD)
Do While Not lngX = 0
strCaption = fGetCaption(lngX)
If Len(strCaption) > 0 Then
lngStyle = GetWindowLong(lngX, mcGWLSTYLE)
'enum visible windows only
If lngStyle And mcWSVISIBLE Then
If fGetClassName(lngX) = "OMain" Then
'******** 'OMain is the class name of a main Access window so if this
window's handle **********
'******** 'differs from your hWndAccessApp then lngX is the handle you want
*****************
If lngX<>hWndAccessApp Then
SendMessage lngX, SW_SHOWMAXIMIZED
Exit Function
End if
End If
End If
End If
lngX = GetWindow(lngX, mcGWHWNDNEXT)
Loop


"Phil" <phil (AT) stantonfamily (DOT) co.uk> wrote

On 17/11/2010 13:42:14, "Jon Lewis" wrote:

Thanks for that

What is mcGWCHILD and mcGWLSTYLE. Won't compile without knowing what thes
(Constants) are and their value

Thanls

Phil

"Phil" <phil (AT) stantonfamily (DOT) co.uk> wrote

Public Const mcGWCHILD = 5
Public Const mcGWHWNDNEXT = 2
Public Const mcGWLSTYLE = (-16)

You can get these values generally by Googling

Jon

On 18/11/2010 16:24:48, "Jon Lewis" wrote:
Thanks Jon

After a little fiddling works perfectly

Phil

It occurs to me that the code will find the handle for any Access
application open so you may want to compare the returns from fGetcaption to
make sure it's the relevant one. I also didn't post the fGetCaption code
so:

Private Const mconMAXLEN = 255

Private Function fGetCaption(hwnd As Long) As String
Dim strBuffer As String
Dim intCount As Integer
strBuffer = String$(mconMAXLEN - 1, 0)
intCount = GetWindowText(hwnd, strBuffer, mconMAXLEN)
If intCount > 0 Then
fGetCaption = Left$(strBuffer, intCount)
End If
End Function

Jon


"Phil" <phil (AT) stantonfamily (DOT) co.uk> wrote

Hi Jon
Thought it was working, but no lock

Here is the code

Function fEnumWindows()

Dim lngx As Long, lngLen As Long
Dim lngStyle As Long, strCaption As String
Dim Otherhwnd As Long

lngx = apiGetDesktopWindow()
'Return the first child to Desktop
lngx = apiGetWindow(lngx, mcGWCHILD)

Do While Not lngx = 0
strCaption = fGetCaption(lngx)
If Len(strCaption) > 0 Then
lngStyle = apiGetWindowLong(lngx, mcGWLSTYLE)
'enum visible windows only
If fGetClassName(lngx) = "OMain" Then ' Databases
If lngStyle And mcWSVISIBLE Then
Debug.Print "Class = " & fGetClassName(lngx),
Debug.Print "Caption = " & fGetCaption(lngx),
Otherhwnd Otherhwnd = apiFindWindow(fGetClassName(lngx), fGetCaption(lngx))
Debug.Print "OtherDb = " & Otherhwnd
Debug.Print "ThisDb = " & GetAccesshWnd()

'******** 'OMain is the class name of a main Access window so if this Window
's handle ********** '******** 'differs from your hWndAccessApp then lngX is
the handle you want***************** If lngx <> hWndAccessApp Then
SendMessage lngx, SW_SHOWMAXIMIZED, 0, 0
Application.Quit
End If
End If
End If
End If
lngx = apiGetWindow(lngx, mcGWHWNDNEXT)
Loop

End Function

Problem is that if any other Access DB is open, this DB (Clubs) immediately
quits. The duff line is If lngx <> hWndAccessApp Then
I Only want to quit the application if someone tries to open up a second copy
of the Clubs database

Thanks, Phil

Well doesn't my post above cover this?

Jon

"Phil" <phil (AT) stantonfamily (DOT) co.uk> wrote

On 22/11/2010 09:03:18, "Jon Lewis" wrote:
Hi Jon

Have pasted your code in exactly as your previous post. This is in my "Clubs"
Db. If I have my "Questions" Db open, then try to open my "Clubs" Db, it
opens and immediately closes.

if I comment out the Application'Quit line, the debug gives me

Class = OMain Caption = WFYC Club DB Phil 0
OtherDb = 788380
ThisDb = 788380
Class = OMain Caption = Microsoft Access - Questionnaire : Database (Access
2007) 788380 OtherDb = 852634

Any further thoughts?

Thanks,
Phil