Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Wscript PopUp make application modal in MS Access 2

Status
Not open for further replies.

patriciaxxx

Programmer
Jan 30, 2012
277
GB
I have posted this in Access modules forum because that’s the application I’m using it in and also the one that I cant get it to be modal in I have tried every variation of vbApplicationModal and numbers I can think of.

Does anyone know how to make the code that runs the PopUp “application modal” in MS Access 2003

'This requires a reference to the Windows Script Host Object Model
Public Sub MessageTest()
Dim SH As IWshRuntimeLibrary.WshShell
Dim Res As Long

Set SH = New IWshRuntimeLibrary.WshShell
Res = SH.PopUp(Text:="Click Me", secondstowait:=2, _
Title:="Hello, World", Type:=vbOKOnly)

End Sub
 
Firstly, why are you using the scripting message box function rather than VBAs? They both simply call the same underlying API call (MessageBox)

Secondly, a MessageBox is modal by definition. There is no magic number (and no parameter in the call) that will make it non-modal. If you need something that looks like a MessageBox but is non-modal you will have to build it yourself from scratch (a user form, an icon, a few buttons)
 
why are you using the scripting message box function rather than VBAs?
I guess the answer is here:
VBShelp said:
If nSecondsToWaitis is greater than zero, the pop-up message box closes after nSecondsToWait seconds.
 
Ok

The reason for using this is I need a msgbox that looks exactly like the ms access one, which this does, but with the option to add timeout, which this has. What I didn’t notice at first is that it is not modal. And I need it modal, it must look and act exactly like ms access msgbox but with timeout functionality.

If you have another way of doing this please post the code for me to look at.

Thank you
 
Yes, the popup does offer that option over and above the standard messagebox (and that makes some sense in the context of the scripting environments, but less sense when using VB or VBA*) - but it is still calling the underlying API and thus fixedly modal (wheteher system, application or the less common task modal). It does not matter what flags Patricia adds to the call, the PopUp will always be at least application modal (since the vbApplicationModal, a Constant, = 0).

So the question then becomes: Patricia, are you saying the popup is behaving non-modally? Or just unexpectedly. It is entirely possible that the scripting team have done something odd to get the timeout timer working for the PopUp.



* A messagebox is specifically designed to show a message that the user must see and acknowledge. That's why it is modal, and that's why you have to click a button to close it. If you don't really care whether a user sees it, then a messagebox is the wrong control to be using, and a quick userform might be preferred (something we cannot always easily do in VBscript, which is why PopUp exists)
 
Hello strongm

Yes the object is completely non modal.
Is there a vbscript msgbox with timeout that can be coded for access vba which I can use.
Do you have an example code for me of msgbox with timeout some way of making it work.
I don’t want form I do want msgbox but with timeout.
 
Take a look at the code on This will give you a configurable API messagebox that counts down for a user definable time.

hth

Ben

----------------------------------------------
Ben O'Hara
David W. Fenton said:
We could be confused in exactly the same way, but confusion might be like Nulls, and not comparable.
 
Completely non-modal

Are you sure? If you do


'This requires a reference to the Windows Script Host Object Model
Public Sub MessageTest()
Dim SH As IWshRuntimeLibrary.WshShell
Dim Res As Long

Set SH = New IWshRuntimeLibrary.WshShell
Res = SH.PopUp(Text:="Click Me", secondstowait:=2, _
Title:="Hello, World", Type:=vbOKOnly)

msgbox "Does this come up straight away or only after the PopUpcloses"
End Sub


what happens?


 
Hello strongm

Tried it out and it comes up after the timeout has finished.

I see your point but I don’t know where it leaves me.

Although the test went the way it did when the popup is displayed you can click anything anywhere on the application. When you use an access msgbox you cant because its modal. This is what I need but with the timeout. Surly for those who know how a few lines of code can achieve this.




 
Hello oharab

Have looked at the code it must do what it says it sure looks complicated way above my basic knowledge. The one thing I did notice is that it uses the “Forms” timer event.

I should have made it more clear but my code executes from a module and the solution I need must be capable of working just in the module.

Have you ever used the code yourself in that way or would you know how to, if so, could you post an example of the code for me to try.
 
It's actually dead simple to use, and can be run in a module too. I imported the code into a test database and it worked almost first time.
Firstly create a new module (I've called it basMessageBoxTimer) and paste the first block of code into it (there's a handy "copy bas code" button which copies it onto the clipboard).

You can then create a new function that behaves pretty much like the standard VBA MsgBox.
Code:
Public Function TimedMsgBox(Prompt As String, Buttons As VbMsgBoxStyle, Title As String) As VbMsgBoxResult
    With cmp
      .sTitle = Title
      .dwStyle = Buttons
      .bUseTimer = True               'True = update once per dwTimerInterval
      .dwTimerDuration = 10           'time to wait seconds
      .dwTimerInterval = 1000         'countdown interval in milliseconds
      .dwTimerExpireButton = vbOK 'message to return if timeout occurs
      .dwTimerCountDown = 0           '(re)set to 0
      .hOwnerThread = Access.hWndAccessApp
      .hOwnerWindow = Access.hWndAccessApp
      .sPrompt = Prompt
   End With
   TimedMsgBox = TimedMessageBoxH(cmp)
End Function

and use it in your code...

Code:
Sub TestMsgBox()
Dim i As Integer
    For i = 0 To 100
        Debug.Print i
        If i = 50 Then
            If TimedMsgBox("Reached the 1/2 way stage.\n" & vbCrLf & _
                           "Closing in %T seconds to do the rest.", _
                            vbOKCancel Or vbCritical, "Just waiting") = vbCancel Then
                Exit For
            End If
        End If
    Next i
End Sub

hth

Ben

----------------------------------------------
Ben O'Hara
David W. Fenton said:
We could be confused in exactly the same way, but confusion might be like Nulls, and not comparable.
 
>Surly for those who know how a few lines of code can achieve this

Actually, no - it's quite hard. The behaviour of modal dialogs (of which a message box) is baked in to Windows at quite a low level, lower than VB normally delves (and certainly lower than VBScript).

I'm afraid that the normal way of dealing with this is to use your own form. Sorry if you are not allowed to do that.

 
Hello oharab,

I have tried the code, I run it just as you have it, I don’t use or have any form. The message box comes up but it doesn’t timeout and close itself. Am I doing something wrong.
 
Ben, I'm not quite sure how you managed to get it working without a timer. And a timer generally requires a form*. And, as patriciaxxx has already stated, she does not appear to be allowed to use a form for whatever reason (seems an odd restriction to me, but there we are)

* Actually, it is possible to write your own timer that does not require a form, but that brings a little more complexity with it ...
 
Hello strongm

* Actually, it is possible to write your own timer that does not require a form, but that brings a little more complexity with it ...

I agree it’s a bit bizarre but that’s the way I need to achieve it. If you know how to get a timer that does not require a form to work with Ben’s configurable MsgBox or one of your own I would be grateful for an example of the code.
 
Ok, I had a quiet moment, so here's something I put together (and I feel it is somewhat simpler than the stuf previously presented here) to implement a working timed message box in Access (the Access specific line - and it is just one line - is commented to show how it can be used in VB6 instead).

1) Create a new module and drop in the following code (this is the custom message box set up):

Code:
[blue]Option Compare Database
Option Explicit

' Necessary constants  for hooking
Private Const HCBT_ACTIVATE = 5
Private Const WH_CBT = 5

' Possibly overkill for this example
Private Type CUSTOM_MSGBOX
    lTimeout As Long
    lExitButton As Long
End Type

Public cm As CUSTOM_MSGBOX

' Working variables that require global scope in hooking module
Private hHook As Long
Public hwndMsgBox As Long
Public lTimerHandle As Long
Public hAppInstance As Long

' The API declarations we need
Public Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Const GWL_HINSTANCE = (-6)


'Windows-defined MessageBox return values
Public Enum ExitButton
    IDOK = 1&
    IDCANCEL = 2&
    IDABORT = 3&
    IDRETRY = 4&
    IDIGNORE = 5&
    IDYES = 6&
    IDNO = 7&
End Enum

' Our wrapper for the normal MsgBox function
Public Function vbTimedMsgBox(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String, Optional HelpFile As String, Optional Context As Long, Optional TimeOut As Long = 0, Optional DefaultExitButton As ExitButton = IDOK) As Long
    cm.lTimeout = TimeOut
    cm.lExitButton = DefaultExitButton
    hAppInstance = GetWindowLong(hWndAccessApp, GWL_HINSTANCE) ' Access specific. In VB, this would be App.hInstance
    hHook = SetWindowsHookEx(WH_CBT, AddressOf WinProc, hAppInstance, 0)
    vbTimedMsgBox = MsgBox(Prompt, Buttons, Title, HelpFile, Context)
End Function

Private Function WinProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim hwndCaption As Long
    Dim CurrentStyle As Long
    Dim ClassName As String
    
    If lMsg = HCBT_ACTIVATE Then
        hwndMsgBox = wParam
        If cm.lTimeout Then lTimerHandle = SetTimer(0&, 0&, cm.lTimeout, AddressOf TimerHandler)
        UnhookWindowsHookEx hHook
    End If

    WinProc = False
End Function[/blue]

In another module (this is the Timer stuff), drop in:

Code:
[blue]Option Compare Database
Option Explicit

Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Public Const IDPROMPT = &HFFFF&


Public Sub TimerHandler(hwnd As Long, uMSG As Integer, idEvent As Integer, dwTime As Double)
    Dim hWndTargetBtn As Long
    
    hWndTargetBtn = GetDlgItem(hwndMsgBox, cm.lExitButton)
         
    ' set the focus to the target button and
    ' simulate a click to close the dialog and
    ' return the correct value
    If hWndTargetBtn <> 0 Then
        SetFocus hWndTargetBtn
        DoEvents
        Call PostMessage(hWndTargetBtn, WM_LBUTTONDOWN, 0, ByVal 0&)
        Call PostMessage(hWndTargetBtn, WM_LBUTTONUP, 0, ByVal 0&)
    End If

    KillTimer 0&, lTimerHandle
    Debug.Print "Timer done"
End Sub[/blue]

And this can be called as follows:

Result = vbTimedMsgBox("Hello", vbOKCancel, , , , 5000, IDCANCEL)

This has been tested in Access 2003, and behaves as expected


 
strongm wow

Copied all the code like you said, it compiles, and the msgbox displays but it didn’t close itself when it timed out.

Does it need something else or am I doing something wrong.

 
Closes on my machine just fine. What version of Access are you using? And what OS? There may be an issue with the hInstance
 
Mine works on my machine too. My example uses the same api timer as yours (SetTimer and KillTimer from the user32 lib). Perhaps the OS/version is the issue here. I'm using Access 2003 on windows XP. The same code (with a minor alteration) works in Excel 2007 too.

Are you using the exact code posted, in a clean database, or are you trying to fit it round your existing code?

Ben

----------------------------------------------
Ben O'Hara
David W. Fenton said:
We could be confused in exactly the same way, but confusion might be like Nulls, and not comparable.
 
The problem may relate to whether you are running on a 32 or 64 bit platform, and whether yoiu are using a 32bit or 64bit version of Access ... I get the same proble if I test in Access 2010 on Windows 7 (because the hook procedure fails, which means the timer is not in operation; it's a graceful fail, but a fail nevertheless). GetDlgItem also fails, which is unexpected.

So - beginning to look like ythis is a Vista/Windows 7 issue
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top