判断指定XLS、DOC文件是否打开自定义函数

tanhong

特别说明：
1、建立名为my.xls和my.doc文件，路径没有特别规定，再进行自定义函数测试；
2、自定义函数需引用EXCEL和WORD对象类库。

'*************************************************************************************
'**程序名：fIsXlsIsOpen函数
'**输    入：ByVal StrXlsName As String
'**输    出：As Boolean
'**功能描述：判断指定的EXCEL文件是否打开
'**全局变量：
'**调用模块：
'**作    者：江羽
'**日    期：2010-10-02 21:29:22
'**修改人：
'**日    期：
'**实    例：If fIsXlsIsOpen("my.xls") = True Then MsgBox "文件已打开"
'**************************************************************************************
Public Function fIsXlsIsOpen(ByVal StrXlsName As String) As Boolean
Dim WN As Workbook
Dim obj As Object
On Error Resume Next

Set obj = GetObject(, "Excel.Application")
If Err.Number <> 0 Then Exit Function

For Each WN In obj.Workbooks
    If WN.Name = StrXlsName Then
       fIsXlsIsOpen = True
    End If
Next
Set obj = Nothing
End Function


'*************************************************************************************
'**程序名：fDocIsOpen函数
'**输    入：ByVal strDocName As String
'**输    出：As Boolean
'**功能描述：判断指定的Word文件是否打开
'**全局变量：
'**调用模块：
'**作    者：江羽
'**日    期：2010-10-02 21:39:28
'**修改人：
'**日    期：
'**实    例：If fDocIsOpen("my.doc")  = True Then MsgBox "文件已打开"
'**************************************************************************************
Public Function fDocIsOpen(ByVal strDocName As String) As Boolean
Dim myDoc As Document
Dim obj As Object
On Error Resume Next

Set obj = GetObject(, "word.Application")
If Err.Number <> 0 Then Exit Function

For Each myDoc In obj.Documents
    If myDoc.Name = strDocName Then
       fDocIsOpen = True
    End If
Next
End Function



实例样本：

tmtony

谢谢分享，很好的函数

li08hua

不错，谢谢分享！

huangjingfeng88

谢谢

asklove

下了就得顶啊

灰太郎

111