اگر پروژه شما با فایل‌هایی غیر از فایل‌های اکسل کار می‌کند، قبل از اینکه بخواهید آن را بخوانید یا روی آن بنویسید، باید آزمایش کنید که آیا یک فایل قبلاً توسط فرآیند دیگری باز است یا خیر. این صفحه تابعی به نام IsFileOpen را توصیف می کند که اگر فایل مشخص شده باز باشد مقدار True را برمی گرداند و اگر فایل مشخص شده باز نباشد، False را برمی گرداند. کد به سادگی با تلاش برای باز کردن فایل برای دسترسی انحصاری کار می کند. اگر فایل با فرآیند دیگری باز شود، تلاش برای باز کردن آن با شکست مواجه خواهد شد. اگر فایل مورد استفاده قرار نگیرد، تلاش برای باز کردن آن با موفقیت انجام می شود. پس از باز شدن، فایل بلافاصله بدون ذخیره بسته می شود.
پارامتر FileName فایل مورد آزمایش را نامگذاری می کند. پارامتر ResultOnBadFile، در صورت وجود، مشخص می‌کند که اگر FileName وجود نداشته باشد یا نام فایل از نظر نحوی نامعتبر باشد، چه مقداری را برگرداند. در صورت وجود، این مقدار برگردانده خواهد شد. اگر این پارامتر حذف شود و FileName وجود نداشته باشد یا نامعتبر باشد، نتیجه False است.
Option Explicit
Option Compare Text
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modIsFileOpen
' By Chip Pearson, www.cpearson.com , chip@cpearson.com
' www.cpearson.com/Excel/IsFileOpen.aspx
' This module contains the IsFileOpen procedure whict tests whether
' a file is open.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function IsFileOpen(FileName As String, _
Optional ResultOnBadFile As Variant) As Variant
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsFileOpen
' 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 Trim(FileName) = vbNullString Then
If IsMissing(ResultOnBadFile) = True Then
IsFileOpen = False
Else
IsFileOpen = 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 = False
Else
IsFileOpen = ResultOnBadFile
End If
Exit Function
ElseIf V = vbNullString Then
' file doesn't exist.
If IsMissing(ResultOnBadFile) = True Then
IsFileOpen = False
Else
IsFileOpen = 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 = False
Case 70
''''''''''''''''''''''''''''''''''''''''''''
' Error number for "Permission Denied."
' File is already opened by another user.
''''''''''''''''''''''''''''''''''''''''''''
IsFileOpen = True
Case Else
''''''''''''''''''''''''''''''''''''''''''''
' Another error occurred. Assume open.
''''''''''''''''''''''''''''''''''''''''''''
IsFileOpen = True
End Select
End Function
ورود به سایت