Question

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

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

Answer 1

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

Answer 2

引用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

追问

Workbooks.Open FileName:="C:\AAAAA\BBBBB.xls"
还望再详尽一些。以上是我文件名称路径。

Answer 3

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

追问

Workbooks.Open FileName:="C:\AAAAA\BBBBB.xls"
还望再详尽一些。以上是我文件名称路径。

追答

set wk=workbooks("BBBBB")
打开语句用你自己的就行

追问

Sub MK231()
Dim wk As Object
On Error Resume Next
Set wk = Workbooks("BBB")
If Err Then '如果是未打开的工作薄，这里就会出现一个错误
Workbooks.Open Filename:="C:\AAA\BBB.xls"
' On Error GoTo 0 '去掉错误捕获

End If
End Sub
成功！谢谢！

Answer 4

Excel本身就有这个功能啊，你这不重复做无用功了吗？

追问

你好！我是多个宏中用到这个文件，但宏没有一定顺序。所以每个宏里都要打开文件，但调用第二个宏时就提示文件已打开，如重新打开就如何如何我也没记清。是这个意思。所以求编码。