【常用自定义函数001】VBA高容错性地打开文件

来源:互联网 发布:软件 质量保证承诺书 编辑:程序博客网 时间:2024/05/17 13:45
代码:

Function OpenExcelFile(sPath As String, ByVal sFileName As String, bDisplay As Boolean, sPwd As String) As Integer
    '打开Excel文件
    'Ver 1.05
    '完成时间:2007.12.01
    '设计:美猴王软件工作室 www.okexcel.com.cn
    '参数说明:
    'sPath:文件绝对路径;sFileName:Excel文件名;bDisplay:True显示错误信息;sPwd:文件打开密码
    '返回值:-1:同名文件已经打开;-2:文件不存在或密码错误;0:成功打开;1:文件已经被打开
    Dim bOpen As Boolean
    Dim sFullName As String
    On Error Resume Next
    If InStr(LCase(sFileName), ".xls") = 0 Then sFileName = sFileName & ".xls"
    sFullName = Workbooks(sFileName).FullName
    '检查是否已经打开同名的Excel文件
    '如果有sFullName不为空
    On Error GoTo 0
    bOpen = False
    If sFullName <> "" Then
        If LCase(sFullName) = LCase(sPath & "/" & sFileName) Then
            bOpen = True
            '判断已经打开的同名文件是否本次需要打开的文件
            OpenExcelFile = 1
            '文件已经被打开
        Else
            If bDisplay Then
                MsgBox "请首先关闭“" & sFileName & "”文件!" & Chr(13) & "不能同时打开同名文件,这是Excel的规定!", vbOKOnly + vbExclamation, "文件的打开错误"
            End If
            bOpen = True
            OpenExcelFile = -1
            '不能同时打开同名文件,这是Excel的规定
        End If
    End If
    If Not bOpen Then
        On Error GoTo errOpen
        Workbooks.Open Filename:=sPath & "/" & sFileName, Password:=sPwd
        On Error GoTo 0
        OpenExcelFile = 0
        '成功打开文件
    End If
    Exit Function
errOpen:
    If bDisplay Then MsgBox Err.Description, vbOKOnly + vbExclamation, "文件的打开错误"
    OpenExcelFile = -2
    '文件不存在或密码错误
    On Error GoTo 0
End Function

原创粉丝点击