如何测试.txt文件是否已被任何人打开?

时间:2015-05-05 22:39:07

标签: excel vba

我正在尝试测试任何人是否已打开.txt或.ini文件。我有几个版本的IsFileOpen。这是直接从http://www.cpearson.com/excel/ISFILEOPEN.ASPX

获取的
Option Explicit
Option Compare Text
Public Function isfileopen_test(FileName As String, _
    Optional ResultOnBadFile As Variant) As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsFileOpen_test
' This function determines whether a the file named by FileName is
' open by another process. The fuction returns True if the file is open
' or False if the file is not open. If the file named by FileName does
' not exist or if FileName is not a valid file name, the result returned
' if equal to the value of ResultOnBadFile if that parameter is provided.xd
' If ResultOnBadFile is not passed in, and FileName does not exist or
' is an invalid file name, the result is False.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim FileNum As Integer
Dim ErrNum As Integer
Dim V As Variant

On Error Resume Next

''''''''''''''''''''''''''''''''''''''''''''
' If we were passed in an empty string,
' there is no file to test so return FALSE.
''''''''''''''''''''''''''''''''''''''''''''
If VBA.Trim(FileName) = vbNullString Then
    If IsMissing(ResultOnBadFile) = True Then
        isfileopen_test = False
    Else
        isfileopen_test = ResultOnBadFile
    End If
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''
' if the file doesn't exist, it isn't open
' so get out now
''''''''''''''''''''''''''''''''''''''''''''
V = Dir(FileName, vbNormal)
If IsError(V) = True Then
    ' syntactically bad file name
    If IsMissing(ResultOnBadFile) = True Then
        isfileopen_test = False
    Else
        isfileopen_test = ResultOnBadFile
    End If
    Exit Function
ElseIf V = vbNullString Then
    ' file doesn't exist.
    If IsMissing(ResultOnBadFile) = True Then
        isfileopen_test = False
    Else
        isfileopen_test = ResultOnBadFile
    End If
    Exit Function
End If

FileNum = FreeFile()
'''''''''''''''''''''''''''''''''''''''
' Attempt to open the file and lock it.
'''''''''''''''''''''''''''''''''''''''
Err.Clear
Open FileName For Input Lock Read As #FileNum
ErrNum = Err.Number
''''''''''''''''''''
' Close the file.
''''''''''''''''''''
Close FileNum
On Error GoTo 0

''''''''''''''''''''''''''''''''''''''
' Check to see which error occurred.
''''''''''''''''''''''''''''''''''''''
Select Case ErrNum
    Case 0
        ''''''''''''''''''''''''''''''''''''''''''''
        ' No error occurred.
        ' File is NOT already open by another user.
        ''''''''''''''''''''''''''''''''''''''''''''
        isfileopen_test = False
    Case 70
        ''''''''''''''''''''''''''''''''''''''''''''
        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        ''''''''''''''''''''''''''''''''''''''''''''
        isfileopen_test = True
    Case Else
        ''''''''''''''''''''''''''''''''''''''''''''
        ' Another error occurred. Assume open.
        ''''''''''''''''''''''''''''''''''''''''''''
        isfileopen_test = True
End Select

End Function

我需要通过VBA这样做。我无法让它用于.txt或.ini文件。如何检查网络上的某人是否已打开txt或ini文件?

编辑:对于txt和ini文件,它返回false,无论它们是否打开。

如果您如此倾向,我正在尝试在客户网络上构建分布式计算系统。我之前从未这样做过,我希望尽可能简单,所以我想通过txt文件进行通信。 MSMQ看起来不错,但它看起来像一条很长的学习曲线。我已经阅读了有关分布式计算的stackoverflow上的所有帖子。

2 个答案:

答案 0 :(得分:1)

一种方法是尝试使用相同的名称重命名文件:

Public Function IsFileLocked(file_path As String) As Boolean
  Dim num As Long

  On Error Resume Next
  Name file_path As file_path
  num = Err.Number
  On Error GoTo 0

  If num <> 0 And num <> 75 Then Error num
  IsFileLocked = num <> 0
End Function

答案 1 :(得分:-1)

OpenFiles 命令使用NetFileEnum

  

NetFileEnum函数返回有关服务器上部分或全部打开文件的信息,具体取决于指定的参数。

NET_API_STATUS NetFileEnum(
  LMSTR servername,
  LMSTR basepath,
  LMSTR username,
  DWORD level,
  LPBYTE* bufptr,
  DWORD prefmaxlen,
  LPDWORD entriesread,
  LPDWORD totalentries,
  PDWORD_PTR resume_handle
);

它说它也是本地计算机,但 Openfiles 需要为本地文件设置一个标志。运行 GFlags 并勾选维护每种类型的对象列表

注意记事本打开,读取和关闭文件。因此,记事本不会打开文件。

对于本地计算机,您可以调用enumwindows,并查看您的文件名是否在任何Window的标题中。此示例使用GetWindow,但文档说EnumWindows是首选。

Public Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
       Private Const GW_CHILD = 5
       Private Const GW_HWNDNEXT = 2
    Sub WindowList()
        Dim hwnd As Long
            hwnd = GetTopWindow(0)
            If hwnd <> 0 Then
                AddChildWindows hwnd, 0
            End If
    End Sub

    Private Function AddChildWindows(ByVal hwndParent As Long, ByVal Level As Long) As String
        Dim gwfnhwnd As Long, X As Long, WT As String, CN As String, Length As Long, hwnd As Long, TID As Long, PID As Long, MN As String, Ret As Long, Parenthwnd As Long
        Static Order As Long
        Static FirstTime As Long
        Parenthwnd = hwndParent
        If Level = 0 Then
                        hwnd = hwndParent
        Else
            hwnd = GetWindow(hwndParent, GW_CHILD)
        End If
        Do While hwnd <> 0
                  WT = Space(512)
                  Length = GetWindowText(hwnd, WT, 508)
                  WT = Left$(WT, Length)
                  If WT = "" Then WT = Chr(171) & "No Window Text " & Err.LastDllError & Chr(187)
                  CN = Space(512)
                  Length = GetClassName(hwnd, CN, 508)
                  CN = Left$(CN, Length)
                  If CN = "" Then CN = "Error=" & Err.LastDllError
                  MsgBox WT & " " & CN
                  hwnd = GetWindow(hwnd, GW_HWNDNEXT)
        Loop
    End Function

COM可以跨计算机和进程进行通信。只需使用Class模块在进程之间构建接口。