如何判断Excel文件是否打开

weiyingde

weiyingde 发表于 2016-9-19 21:06
赵老师，你这是在已经启动了excel的前提下的情形吧？
假如情况是这样的：
操作平台：ppt的VBA

我的代码这样写，却没有任何反应，赵老师帮我看看,代码如下：
Private Declare Function MessageBoxTimeout Lib "user32" Alias "MessageBoxTimeoutA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long, ByVal wlange As Long, ByVal dwTimeout As Long) As Long '申明自动关闭对话框
sub 避免重复的打开优盘文件（）
On Error Resume Next
Call 检测优盘
myfil = "H:\ofenused\课堂答问记分系统.xslm"
If Dir(myfil) Then
     s = "该处没有文档"
     MessageBoxTimeout 0, s, Space(5) & "温馨提示", 0, 1, 2000
     Exit Sub
  Else
     Set xlapp = GetObject(, "Excel.Application")
     If Err.Number <> 0 Then
        Set xlapp = CreateObject("Excel.Application")
        Dim wbXL As excel.Workbook
        xlapp.Workbooks.Open myfil
        xlapp.Visible = False
        xlapp.DisplayAlerts = False
        Set wbXL = xlapp.Workbooks.Activate
        arr = wbXL.Sheets("名单").Range("A1:A" & [A65536"].End(3).Row)
     Else
        For Each wb In Workbooks
           If wb.Name = myfil Then
               Set wbXL = xlapp.wb.Activate
               arr = wbXL.Sheets("名单").Range("A1:A" & [A65536"].End(3).Row)
               Exit For
            End If
        Next
      end if
    End If
xlapp.DisplayAlerts = False
Debug.Print UBound(arr)
End Sub

Sub 检测优盘()
Application.DisplayAlerts = False
    Dim s$, ilj$, ipth$, msg1$, msg2$, msg3$
    Set yy = CreateObject("sapi.spvoice")
    ipth = Split(ActivePresentation.Path, ":")(0) & ":"
    msg1 = "请插入优盘！"
    msg2 = "请将优盘符改为H:"
    msg3 = "请在H盘中运行本文档！"
    For Each f In CreateObject("Scripting.FileSystemObject").Drives
    If f.drivetype = 1 Then s = f.Path: Exit For
    Next
If s <> "" Then
    If s = "H:" Then
       If s <> ipth Then
         MessageBoxTimeout 0, msg3, Space(3) & "友情提示", 0, 1, 1000
         yy.Speak msg3
         ActivePresentation.Close
         Application.Quit
       End If
    Else
    MessageBoxTimeout 0, msg2, Space(3) & "友情提示", 0, 1, 1000
    yy.Speak msg2
    ActivePresentation.Close
    Application.Quit
    End If
  Else
  MessageBoxTimeout 0, msg1, Space(3) & "友情提示", 0, 1, 1000
  yy.Speak msg2
  ActivePresentation.Close
  Application.Quit
  End If
End Sub

weiyingde

zhaogang1960 发表于 2014-12-30 22:36
请注意，如果已经打开的工作簿不多，可以使用该方法，否则应该使用直呼其名法(2楼第

求大虾助我，多谢了，多谢了

godtale

weiyingde 发表于 2016-9-19 23:01
我的代码这样写，却没有任何反应，赵老师帮我看看,代码如下：
Private Declare Function MessageBoxTi ...

另存为到可移动磁盘？

weiyingde

不是的，是想知道当前打开的文档是否在是U盘上的文档

weiyingde

这问题已经解决了。谢谢你。

啊谢

zhaogang1960 发表于 2014-12-30 22:36
请注意，如果已经打开的工作簿不多，可以使用该方法，否则应该使用直呼其名法(2楼第二种方法)

老师 如果文件是存放局域网服务器上的 如何判断别人有没有打开这个文件在编辑（我的权限只有只读）

hately

zhaogang1960 发表于 2014-12-28 13:18
方法1思路不正确，历遍所有工作簿必须循环完毕后再做结论：

非常感谢！

aliCT

正在学习vba

ning84

qy1219no2 发表于 2014-12-26 13:08
两种方法：
一种，遍历WorkBook集合，如果集合中存在需要打开的工作薄名称，则表示该工作薄已经打开了，否 ...

1. Sub test0214()
   
2.     Dim xlApp As Excel.Application
   
3.     Dim xlWk As Workbook, tmpWk As Workbook
   
4.     Dim Str
   
5.       
   
6.         Set xlApp = New Excel.Application
   
7.         Str = "D:\Book.xls"
   
8.         For Each tmpWk In Workbooks ' xlApp.Application.Workbooks
   
9.               If tmpWk.Name = Str Then
   
10.                   
    
11.               Else
    
12.                   Set xlWk = Workbooks.Open(Str)  'xlApp.Application.Workbooks.Open(Str)
    
13.               End If
    
14.         Next tmpWk
    
15.         
    
16.         Str = xlWk.Name
    
17.         Str = xlWk.Name
    
18.         Stop
    
19.         Application.Run Str & "!ll"
    
20.         xlWk.Close Str
    
21.         Set xlWk = Nothing
    
22.         Stop
    
23.    
    
24. End Sub
    

复制代码