我正在尝试测试任何人是否已打开.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上的所有帖子。
答案 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模块在进程之间构建接口。