完美Excel

Function IsWorkbookOpen(wbk As String) As Boolean
    Dim wbT As Excel.Workbook
    Err.Clear
    On Error Resume Next
    Set wbT = Application.Workbooks(wbk)
    '如果工作簿已打开则wbT将包含该工作簿对象
    IsWorkbookOpen = Not wbT Is Nothing
    Err.Clear
    On Error GoTo 0
End Function

Function WorkbookIsOpen(wbkName) As Boolean
    '如果所给工作簿已打开则返回True
    Dim wbk As Workbook
    On Error Resume Next
    Set wbk = Workbooks(wbkName)
    If Err = 0 Then
        WorkbookIsOpen = True
    Else
        WorkbookIsOpen = False
    End If
End Function

Function WorkbookOpen(WorkBookName As String) As Boolean
    '如果该工作簿已打开则返回真
    WorkbookOpen = False
    On Error GoTo WorkBookNotOpen
    If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
        WorkbookOpen = True
        MsgBox "该工作簿已打开"
        Exit Function
    End If
WorkBookNotOpen:
End Function

Function IsWorkbookOpen(sWorkbook As String) As Boolean
    Dim sName As String
    Dim sPath As String
    Dim sFullName As String
    On Error Resume Next
    IsWorkbookOpen = True
    '判断所给的工作簿名称是否带有路径名
    If InStr(1, sWorkbook, "\", vbTextCompare) > 0 Then
        '文件名带有路径,需要分解
        sFullName = sWorkbook
        BreakdownName sFullName, sName, sPath
        If StrComp(Workbooks(sName).FullName, sWorkbook, 1) <> 0 Then
            IsWorkbookOpen = False
        End If
    Else
        If StrComp(Workbooks(sWorkbook).Name, sWorkbook, 1) <> 0 Then
            IsWorkbookOpen = False
        End If
End Function
 
Sub BreakdownName(sFullName As String, _
                  ByRef sName As String, _
                  ByRef sPath As String)
    Dim nPos As Integer
    '找出文件名从哪里开始
    nPos = FileNamePosition(sFullName)
    If nPos > 0 Then
        sName = Right(sFullName, Len(sFullName) - nPos)
        sPath = Left(sFullName, nPos - 1)
    Else
        '无效的文件名
    End If
End Sub
 
'返回提供的完整文件名中文件名的位置或首字符索引值
'完整文件名包括路径和文件名
'例如:FileNamePosition("C:\Testing\Test.xlsx")=11
Function FileNamePosition(sFullName As String) As Integer
    Dim bFound As Boolean
    Dim nPosition As Integer
    bFound = False
    nPosition = Len(sFullName)
    Do While bFound = False
        '确保不是零长度字符串
        If nPosition = 0 Then Exit Do
        '从右开始查找第一个"\"
        If Mid(sFullName, nPosition, 1) = "\" Then
            bFound = True
        Else
            '从右至左
            nPosition = nPosition - 1
        End If
    Loop
    If bFound = False Then
        FileNamePosition = 0
    Else
        FileNamePosition = nPosition
    End If
End Function