设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 3518|回复: 5

[模块/函数] 判断指定XLS、DOC文件是否打开自定义函数

[复制链接]
发表于 2010-10-18 11:29:14 | 显示全部楼层 |阅读模式
特别说明:
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



实例样本:

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

评分

参与人数 1经验 +10 收起 理由
todaynew + 10 我很赞同

查看全部评分

点击这里给我发消息

发表于 2010-10-18 11:31:23 | 显示全部楼层
谢谢分享,很好的函数
发表于 2010-10-18 23:08:23 | 显示全部楼层
不错,谢谢分享!
发表于 2010-10-19 18:23:49 | 显示全部楼层
谢谢
发表于 2010-10-21 15:12:50 | 显示全部楼层
下了就得顶啊
发表于 2021-1-14 20:03:05 | 显示全部楼层
111
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-3-28 23:28 , Processed in 0.087722 second(s), 32 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表