Bài viết: UDF hữu ích: Một số hàm thông dụng cần thiết (1 người xem)

[levanduyet]

Khi lập trình VBA, một số thao tác các bạn thường xuyên sử dụng như:

• Kiểm tra tập tin có tồn tại hay không?
• Kiểm tra đường dẫn có tồn tại hay không?
• ....

Tôi xin giới thiệu các bạn 6 hàm sau:

• 1) FileExists: kiểm tra sự tồn tại của tập tin - Trả về TRUE nếu tập tin tồn tại.
• 2) FileNameOnly: lấy tên tập tin từ đường dẫn.
• 3) PathExists : kiểm tra đường dẫn có tồn tại hay không? - Trả về TRUE nếu đường dẫn tồn tại.
• 4) RangeNameExists : kiểm tra tên của một vùng (Range) có tồn tại hay không? - Trả về TRUE nếu tên vùng tồn tại.
• 5) SheetExists : kiểm tra sheet có tồn tại hay không? - Trả về TRUE nếu sheet tồn tại.
• 6) WorkBookIsOpen : kiểm tra xem tập tin có đang mở hay không? - Trả về TRUE nếu tập tin đang mở.

Private Function FileExists(fname) As Boolean
'   Returns TRUE if the file exists
    Dim x As String
    x = Dir(fname)
    If x <> "" Then FileExists = True _
        Else FileExists = False
End Function


Private Function FileNameOnly(pname) As String
'   Returns the filename from a path/filename string
    Dim i As Integer, length As Integer, temp As String
    length = Len(pname)
    temp = ""
    For i = length To 1 Step -1
        If Mid(pname, i, 1) = Application.PathSeparator Then
            FileNameOnly = temp
            Exit Function
        End If
        temp = Mid(pname, i, 1) & temp
    Next i
    FileNameOnly = pname
End Function


Private Function PathExists(pname) As Boolean
'   Returns TRUE if the path exists
    Dim x As String
    On Error Resume Next
    x = GetAttr(pname) And 0
    If Err = 0 Then PathExists = True _
      Else PathExists = False
End Function


Private Function RangeNameExists(nname) As Boolean
'   Returns TRUE if the range name exists
    Dim n As Name
    RangeNameExists = False
    For Each n In ActiveWorkbook.Names
        If UCase(n.Name) = UCase(nname) Then
            RangeNameExists = True
            Exit Function
        End If
    Next n
End Function


Private Function SheetExists(sname) As Boolean
'   Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(sname)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
End Function


Private Function WorkbookIsOpen(wbname) As Boolean
'   Returns TRUE if the workbook is open
    Dim x As Workbook
    On Error Resume Next
    Set x = Workbooks(wbname)
    If Err = 0 Then WorkbookIsOpen = True _
        Else WorkbookIsOpen = False
End Function

Nguồn tham khảo tại đây.

Cách khác để kiểm tra sự tồn tại của một tập tin:
Ngoài ra chúng ta cũng có thể dùng FileSystemObject để kiểm tra sự tồn tại của một tập tin. Hàm FileExists có thể viết lại như sau:

Function FileExists(ByVal fname As String) As Boolean
Set fs = CreateObject("Scripting.FileSystemObject")
FileExists = fs.FileExists(fname)
End Function

Một cách khác:

Function bFileExists(rsFullPath As String) As Boolean
bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function

Cách tương tự nhưng bạn có thể kiểm tra sự tồn tại của tập tin/thư mục. Nguồn từ đây.

Public Function FileFolderExists(strFullPath As String) As Boolean
'Tác giả/Author : Ken Puls (www.excelguru.ca)
'Mục đích/Macro Purpose: Kiểm tra sự tồn tại của một tập tin/thư mục - Check if a file or folder exists

On Error GoTo EarlyExit
If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True

EarlyExit:
On Error GoTo 0

End Function

Cách khác để kiểm tra sự workbook có đang mở hay không:

Function bWorkbookIsOpen(rsWbkName As String) As Boolean
On Error Resume Next
bWorkbookIsOpen = CBool(Len(Workbooks(rsWbkName).Name) > 0)
End Function

Một hàm cùng chức năng để các bạn tham khảo:
Nguồn tại đây.
Các bạn đưa đoạn mã sau vào một module.

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.
' Module chứa hàm IsFileOpen nhằm kiểm tra việc tập tin đang mở hoặc đang
' được sử dụng bởi một process khác
'

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

Chú ý: với cách ở trên thì hàm cũng kiểm tra luôn trong các process (Ví dụ: khi bạn vào Start>All Programs>Microsoft Office>Microsoft Excel, mở một tập tin. Sau đó bạn mở một tập tin khác cũng bằng cách này. Sau đó bạn nhấn tổ hợp Ctrl + Alt + Delete: bạn sẽ thấy hai process Excel.exe ) đang mở khác.
Cách tương tự, viết ngắn gọn lại, dễ hiểu hơn như sau:

Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long

On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error Goto 0

Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select

End Function

Sub test()
If Not IsFileOpen("C:\MyTest\volker2.xls") Then
Workbooks.Open "C:\MyTest\volker2.xls"
End If
End Sub

Hoặc các bạn cũng có thể tham khảo tại đây: http://support.microsoft.com/?kbid=138621
Đoạn code tương ứng với link ở trên của Microsoft như sau:

Sub TestFileOpened()

' Test to see if the file is open.
If IsFileOpen("c:\Book2.xls") Then
' Display a message stating the file in use.
MsgBox "File already in use!"
'
' Add code here to handle case where file is open by another
' user.
'
Else
' Display a message stating the file is not in use.
MsgBox "File not in use!"
' Open the file in Microsoft Excel.
Workbooks.Open "c:\Book2.xls"
'
' Add code here to handle case where file is NOT open by
' another user.
'
End If
End Sub

Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer

On Error Resume Next 'Tắt việc kiểm tra lỗi.
filenum = FreeFile() ' Get a free file number.
' Thử mở tập tin vào khóa nó
Open filename For Input Lock Read As #filenum
Close filenum ' Đóng tập tin
errnum = Err ' Lưu lại lỗi xãy ra
On Error GoTo 0 ' Mở lại việc kiểm tra lỗi

' Kiểm tra xem lỗi gì xãy ra
Select Case errnum

' Không có lỗi xãy ra
' Tập tin chưa mở bởi người dùng khác
Case 0
IsFileOpen = False

' Error number for "Permission Denied."
' Tập tin được mở bởi người dùng khác
Case 70
IsFileOpen = True

' Lỗi khác xãy ra
Case Else
Error errnum
End Select
End Function

Cách khác để kiểm tra sự tồn tại của worksheet:

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

Các bạn có thể tham khảo thêm tại http://www.rondebruin.nl/exist.htm.

 

[nnpc]

sẽ học hỏi thêm . Cảm ơn bác