求Excel避免重复打开文件的VBA编码

如题，如果文件已打开就跳过，否则打开该文件。
求VBA编码。谢谢！

dim wk as object
on error resume next
set wk=workbooks("工作薄名")
if err then '如果是未打开的工作薄，这里就会出现一个错误
workbooks.open .......
.......
on error goto 0'去掉错误捕获

把下面的代码复制到工作簿的 thisworkbook 模块里面就可以了 option explicit private sub workbook_open()     dim l as long     l = sheets("p").range("a60000").end(xlup).row     '这里假定日期保存在a列的最后一个单元格，你可以自己修改range("a60000")为range("c60000")等等。     if sheets("p").range("a" & l).value = datevalue(now) then         '这里也假定日期保存在a列的最后一个单元格，你可以自己修改range("a" & l)为range("c" & l)等等，和上面的要一致。         p2         thisworkbook.save     end if end sub sub p2()     msgbox "yes" end sub

1.直接用代码判断文件是否打开,因为你有多个过程要判断一个指定的文件是否打开,建议你把下面代码中的BL变量定义为公共变量.其他的过程,直接判断BL的值,就可以知道指定的文件是否打开了. Sub openfile() Dim FilePath, FileName As String Dim BookName As Workbook Dim BL As Boolean FilePath = "C:\AAAAA\BBBBB.xls" '包含路径的文件名 FileName = Right(FilePath, Len(FilePath) - InStrRev(FilePath, "\")) '获取文件名 For Each BookName In Workbooks '判断指定文件是否打开的循环 If BookName.Name = FileName Then BL = True '如果指定的文件已经打开 BL变量赋值为True Next If BL = False Then Workbooks.Open FileName:=FilePath 'if BL的值为False,则执行打开指定文件 End Sub 2.用自定义函数 因为你有多个宏要判断指定的文件是否打开,用一个判断文件是否打开的的自定义函数 ,在你的过程中调用这个函数 Function OpenFileBL(filepath) As Boolean Dim filename As String Dim BookName As Workbook filename = Right(filepath, Len(filepath) - InStrRev(filepath, "\")) '获取文件名 For Each BookName In Workbooks '判断指定文件是否打开的循环 If BookName.Name = filename Then OpenFileBL = True '如果指定的文件已经打开 BL变量赋值为True Next End Function Sub test() fp = "C:\AAAAA\BBBBB.xls" If Not OpenFileBL(fp) Then Workbooks.Open filename:="C:\AAAAA\BBBBB.xls" '通过Openfilebl自定义函数判断指定的文件是否打开,如果没有打开就打开指定的文件 End Sub

引用sxpose兄弟空间的一段代码 VBA 判断某文件是否打开 Function IsFileOpen(FileName As String) Dim iFilenum As Long Dim iErr As Long On Error Resume Next ' 改变错误处理的方式。 iFilenum = FreeFile() '使用 FreeFile 给iFilenum提供一个尚未使用的文件号 Open FileName For Input As #iFilenum '打开该文件 Close iFilenum iErr = Err On Error GoTo 0 Select Case iErr Case 0: IsFileOpen = False '文件没有打开 Case 70: IsFileOpen = True '文件已经打开 Case Else: Error iErr End Select End Function Sub OpenTest() Dim myfile As String myfile = ThisWorkbook.Path & "\mybook.xls" '当前目录下的mybook文件 If Not IsFileOpen(myfile) Then '判断文件是否打开，如果文件没有打开的话，则打开该文件 Workbooks.Open myfile End If End Sub