Java应用运行时阻止Access应用操作的技术需求

你需要的核心效果其实就是让Access进入模态锁定状态——就像它打开第二个模态表单时，主界面完全无法操作那样。你的ShellSync函数已经实现了等待Java进程结束的核心逻辑，我们只需要稍作调整，就能让Access在Java运行期间彻底锁定，避免用户误操作触发bug。

关键原理 #

普通的Shell函数会异步启动Java程序，Access仍然可以被操作；而你的ShellSync是同步等待，但默认情况下Access在等待时可能会出现假死或者仍能被交互。我们要做的是：

• 用模态表单锁定Access主界面
• 在等待Java进程时，用DoEvents维持必要的UI响应，同时保持锁定

修改后的同步Shell函数 #

我调整了你的ShellSync，加入了循环等待和DoEvents，既保证等待Java结束，又不会让Access完全假死：

Option Compare Database
Option Explicit

Private Const INFINITE = &HFFFFFFFF
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Const WAIT_TIMEOUT = &H102& ' 新增等待超时常量

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
    ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliseconds As Long)

' 同步启动进程并锁定Access UI，返回进程退出码，出错抛异常
Public Function ShellSyncAndLock(ByVal PathName As String, ByVal WindowStyle As VbAppWinStyle) As Long
    Dim lngPid As Long
    Dim lngHandle As Long
    Dim lngExitCode As Long
    Dim lngWaitResult As Long
    
    lngPid = Shell(PathName, WindowStyle)
    If lngPid <> 0 Then
        lngHandle = OpenProcess(SYNCHRONIZE Or PROCESS_QUERY_INFORMATION, 0, lngPid)
        If lngHandle <> 0 Then
            ' 循环等待，每100ms检查一次进程状态，同时处理UI消息
            Do
                lngWaitResult = WaitForSingleObject(lngHandle, 100)
                DoEvents ' 维持UI基本响应，避免假死
            Loop Until lngWaitResult <> WAIT_TIMEOUT
            
            If GetExitCodeProcess(lngHandle, lngExitCode) <> 0 Then
                ShellSyncAndLock = lngExitCode
                CloseHandle lngHandle
            Else
                CloseHandle lngHandle
                Err.Raise &H8004AA00, "ShellSyncAndLock", "无法获取进程退出码，错误：" & CStr(Err.LastDllError)
            End If
        Else
            Err.Raise &H8004AA01, "ShellSyncAndLock", "无法打开子进程句柄"
        End If
    Else
        Err.Raise &H8004AA02, "ShellSyncAndLock", "无法启动子进程"
    End If
End Function

如何使用 #

1. 设置启动表单为模态：在你用来启动Java的Access表单属性里，把弹出方式设为“是”，模态设为“是”。这样表单运行时，Access主界面会被自动锁定。
2. 在按钮点击事件中调用函数：

Private Sub cmdLaunchJava_Click()
    ' 确保表单是模态弹出状态（也可以在设计时直接设置）
    Me.PopUp = True
    Me.Modal = True
    
    Dim jarFullPath As String
    ' 替换成你的jar包实际路径，注意空格路径要加引号
    jarFullPath = "C:\MyApps\MyJavaDragDropApp.jar"
    Dim exitCode As Long
    
    On Error GoTo ErrorHandler
    ' 启动Java程序并等待它退出
    exitCode = ShellSyncAndLock("java -jar """ & jarFullPath & """", vbNormalFocus)
    MsgBox "Java应用已关闭，退出码：" & exitCode, vbInformation
    Exit Sub
    
ErrorHandler:
    MsgBox "启动Java应用失败：" & Err.Description, vbCritical
End Sub

为什么这能解决你的问题？ #

• 模态表单直接锁定了Access的主窗口，用户根本切不回去操作，从根源上避免触发bug。
• 循环等待+DoEvents让Access不会完全假死，你甚至可以在表单上放个“等待中...”的标签，提升用户体验。
• 同步等待逻辑确保只有Java应用退出后，Access才会恢复可操作状态。

额外小提示 #

• 如果你的Java程序需要和Access做数据交互，这种完全锁定的方式就不适用了，得用异步启动+窗口监听的方案，但复杂度会高很多。
• 测试时一定要检查jar包路径，尤其是路径里有空格的话，必须用双引号包裹，否则会启动失败。

内容的提问来源于stack exchange，提问作者TND