Public Function IsOpenAcc(Str As String)
On Error GoTo EX:
Dim conn As Object
Set conn = CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.ace.OLEDB.12.0;;User ID=Admin;Data Source=" & Str & ";"
MsgBox "文件没有打开！"
Exit Function
EX:
If Err.Number = -2147467259 Then
MsgBox "文件已被打开！"
End If
End Function


Sub TEST()
IsOpenAcc ("access文件完整路径包括文件名")
End Sub