6个简单而有用的VBA自定义函数

VBA内部有许多有用的内建函数，但对于好些常规任务(或常见的问题)仍然需要编写自定义函数，这些问题是比较通用的。如检查一个文件是否存在等。

这里包括了6个非常有用自定义VBA函数，你可以简单的复制这些代码到你的模块中，以备方便调用。

这些函数包括：
FileExists：检查一个文件是否存在
– Returns TRUE if a particular file exists.
FileNameOnly：从路径中提取文件名
– Extracts the filename part of a path/filename string.
PathExists：检查路径是否存在
– Returns TRUE if a particular path exists.
RangeNameExists：区域名称是否已存在
– Returns TRUE if a particular range name exists.
SheetExists：检查工作表是否存在
– Returns TRUE if a particular sheet exists.
WorkBookIsOpen：检查工作簿是否打开
– Returns TRUE if a particular workbook is open.
具体代码如下：
The FileExists Function

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

The FileNameOnly 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

The PathExists 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

The RangeNameExists 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

The SheetExists 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

The WorkbookIsOpen 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