もし該当のアクセスファイルが開いているのなら開かな

質問

エクセルからアクセスを開く方法を教えてください。
そして、
「もし該当のアクセスファイルが開いているのなら開かない」
と言う条件も付け加えたいです。

Sub test１()
Dim strAcName As String
Dim accApp As Object

strAcName = "D:\ アクセスファイル名.mdb "

「GetObject」「CreateObject」どちらにしても結果は同じ？
Set accApp = GetObject(strAcName)
Set accApp = CreateObject(strAcName)

既にAccessファイルを開いている場合は、Visible = Trueにしたらエラーになる。
If Not accApp Is Nothing Then
accApp.Visible = True
accApp.OpenCurrentDatabase (strAcName)
End If

Set accApp = Nothing
End Sub

だと、
OpenCurrentDatabase
の部分で、実行時エラー7867
既にこのデータベースは開いています。
になります。

だからってこの部分をコメントアウトすると
前回と同じように
Set accApp = Nothingを通り越すと
折角開いたアクセスファイルが閉じてしまいます。

エクセルからアクセスを開く時にもハイパーリンクで

Sub test2()
Dim strAcName As String
strAcName = "D:\ アクセスファイル名.mdb "

ThisWorkbook.FollowHyperlink strAcName
End Sub

で開けたのですが、
「もし該当のアクセスファイルが開いているのなら開かない」
が出来ないので、
「GetObject」か「CreateObject」を
使って開くのかな？と思っています。

回答No.1

NotFound404 · ベストアンサー

自身のPCでローカル上のファイルを開いているかの確認は
簡易的にはロック情報ファイルの有無を確認すれば良いと思います。
D:\ アクセスファイル名.mdb → D:\ アクセスファイル名.ldb
2007以降の accdb なら laccdb。
ただ、ファイルを閉じるときにldbファイルが消えずに残ってしまう場合があります。
なので標準モジュールに

Function chkAcc(AccFile As String) As Boolean
'ldb、laccdb ファイルが有効であればTrueを返します。
On Error GoTo errH
If Dir(AccFile) = "" Then
chkAcc = False
Exit Function
End If

Name AccFile As AccFile '同名でリネーム試行
chkAcc = False
Exit Function

errH:
chkAcc = True
End Function

と作成し、サブモジュールでは
If chkAcc(""D:\ アクセスファイル名.ldb "") then
msgbox "既に開いています"
exit sub
end if
のようにチェックしてみるとか・・・。

ただ２、mdbファイルを排他モードで開いている場合は、ldb ファイルは
作成されませんので、この手は使えません。
以上ご参考まで。

お礼

どうもありがとうございました。