'Modul:
Option Explicit
 
'API Deklarationen
Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As _
  Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal _
  lParameter As Long, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function CreateDesktop Lib "user32" Alias "CreateDesktopA" ( _
ByVal lpszDesktop As Long, ByVal lpszDevice As Long, pDevmode As Any, ByVal _
dwFlags As Long, ByVal dwDesiredAccess As Long, lpsa As Any) As Long
Private Declare Function SwitchDesktop Lib "user32" (ByVal hDesktop As Long) As _
Long
Private Declare Function GetThreadDesktop Lib "user32" (ByVal dwThread As Long) _
As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetCurrentThread Lib "kernel32" () As Long
Private Declare Function OpenInputDesktop Lib "user32" (ByVal dwFlags As Long, _
  ByVal fInherit As Boolean, ByVal dwDesiredAccess As Long) As Long
Private Declare Function SetThreadDesktop Lib "user32" (ByVal hDesktop As Long) _
As Long
Private Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Long) As _
Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _
Long
Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, _
ByVal dwExitCode As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As _
Long, lpExitCode As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal _
nCmdShow As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
'Konstanten
Private Const SW_HIDE = 0
Private Const SW_NORMAL = 1
 
'Typen
Private Enum DESKTOP_ACCESS_MASK
DESKTOP_DELETE = &H10000
DESKTOP_WRITE_DAC = &H40000
DESKTOP_WRITE_OWNER = &H80000
DESKTOP_NONE = 0
DESKTOP_READOBJECTS = &H1
DESKTOP_CREATEWINDOW = &H2
DESKTOP_CREATEMENU = &H4
DESKTOP_HOOKCONTROL = &H8
DESKTOP_JOURNALEDRECORD = &H10
DESKTOP_JOURNALEDPLAYBACK = &H20
DESKTOP_ENUMERATE = &H40
DESKTOP_WRITEOBJECTS = &H80
DESKTOP_SWITCHDESKTOP = &H100
GENERIC_ALL = (DESKTOP_DELETE Or DESKTOP_WRITE_DAC Or DESKTOP_WRITE_OWNER Or _
  DESKTOP_READOBJECTS Or DESKTOP_CREATEWINDOW Or DESKTOP_CREATEMENU Or _
  DESKTOP_HOOKCONTROL Or DESKTOP_JOURNALEDRECORD Or DESKTOP_JOURNALEDPLAYBACK _
  Or DESKTOP_ENUMERATE Or DESKTOP_WRITEOBJECTS Or DESKTOP_SWITCHDESKTOP)
GENERIC_SPECIFIC = (DESKTOP_CREATEWINDOW Or DESKTOP_SWITCHDESKTOP)
End Enum
 
'Variablen
Private hWnd As Long 'WindowHandle
Private hThread As Long 'ThreadHandle
Private ThreadId As Long 'ThreadID
 
Private D As Long 'NewDesktopHandle
Private oldDT As Long 'oldDesktopThreadHandle
Private oldDI As Long 'oldInputDesktopHandle
 
'Funktionen
Private Function StartDelegate()
'Speichere Handles
oldDT = GetThreadDesktop(GetCurrentThreadId())
oldDI = OpenInputDesktop(1, True, GENERIC_ALL)
 
'Neuer Desktop
D = CreateDesktop(StrPtr("MDeskKiosk"), ByVal 0&, ByVal 0&, 1, GENERIC_ALL, _
  ByVal 0&)
 
'Verschiebe Thread
If SetThreadDesktop(D) = 0 Then
    MsgBox err.LastDllError
    Exit Function
Else:
    SwitchDesktop D
End If
 
 
'*****************
'Diese Beiden Methoden funktionieren nicht: (keine Fehlermeldung, es passiert 
' einfach  NICHTS)
DoCmd.OpenForm "Kiosk", acNormal
 
' ODER:
ShowWindow hWnd, SW_NORMAL
'*****************
 
Do While CurrentProject.AllForms("Kiosk").IsLoaded
    'ShowWindow hWnd, SW_NORMAL 'verzweifelter Versuch...
    DoEvents
    Sleep 500
Loop
 
 
End Function
 
Public Function Master(Handle As Long) 'Wird von Form über "Master Me.HWND" _
  gerufen
'speichere Hanlde
hWnd = Handle
 
'neuer Thread
hThread = CreateThread(ByVal 0&, 0&, AddressOf StartDelegate, 0&, 0&, ThreadId)
 
'gehe sicher, dass Form geladen ist
Do While Not CurrentProject.AllForms("Kiosk").IsLoaded
    DoEvents
    Sleep 500
Loop
 
'warte, bis Form geschlossen ist
Do While CurrentProject.AllForms("Kiosk").IsLoaded
    DoEvents
    Sleep 500
Loop
 
'Und alles auf Anfang
DestroyThread
SwitchDesktop oldDI
CloseDesktop D
CloseHandle D
 
End Function
 
Private Function DestroyThread() 'beende Thread, lösche Handles 
Dim hExit As Long
GetExitCodeThread hThread, hExit
If TerminateThread(hThread, hExit) = 0 Then
    MsgBox err.LastDllError
Else
    CloseHandle hThread
End If
End Function