查看完整版本: VB打开ET文件前检查表格是否已打开

VB打开ET文件前检查表格是否已打开

VB打开WPS表格时，如果用户已经把表格打开，则WPS提示“文件已打开，是否以只读模式打开？”，如果以只读模式打开，则VB无法写入数据，并且写入出错后VB无法处理发生的错误。
因此需要在打开前判断是否已经打开，在VB工程里添加一个模块，复制以下代码：

Option Explicit
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Function chkEtFileOpen(ByVal etFileName As String, Optional ByVal winAppTitle As String = "WPS 表格") As Boolean
  Dim strWinTitle As String, Ret As Long
  Dim hdlWin As Long, hdlTxt As Long
  ' 从桌面开始查询所有窗口
    hdlWin = GetDesktopWindow()
    hdlTxt = GetWindow(hdlWin, GW_CHILD)
    chkEtFileOpen = False
    Do
        Ret = GetWindowTextLength(hdlTxt)
        strWinTitle = Space(Ret)
        GetWindowText hdlTxt, strWinTitle, Ret + 1
        If winAppTitle = "" Then
          If InStr(1, strWinTitle, etFileName) > 0 Then
            chkEtFileOpen = True
            Exit Do
          End If
        Else
          If InStr(1, strWinTitle, etFileName) > 0 And InStr(1, strWinTitle, winAppTitle) > 0 Then
            chkEtFileOpen = True
            Exit Do
          End If
        End If
        hdlTxt = GetWindow(hdlTxt, GW_HWNDNEXT)
        If hdlTxt = 0 Then Exit Do
    Loop
End Function


在打开前用chkEtFileOpen(“表格文件名称”)检查：
if chkEtFileOpen(“表格文件名称”) then
  msgbox "表格文件已打开，请先关闭此文件。"
  exit sub
end if