判斷指定XLS、DOC文件是否打開自定義函數

tanhong

特別說明：
1、建立名為my.xls和my.doc文件，路徑沒有特別規(guī)定，再進行自定義函數測試；
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