accessから別に開いているaccessを閉じたい

Question

今開いているaccessから他に複数開いているaccessを一度に閉じたいのですが、どのような方法がありますでしょうか？

追記)
メインとなるaccessから他の複数のaccessを開いたり、閉じたりすることとして…
メインのaccessに下記コードを入力してみたところ、特定のaccessを閉じることができました。これを応用して複数指定したら、複数のaccessを閉じるれかも…と思いましたが、その特定のaccessが開いていないときに一度開いて閉じるみたいな動きになるため、現在閉じようとしているaccesが開いているのか判定する必要があるのかもしれません。

private sub コマンド1_Click
Dim ac As Object
Set ac= GetObject("●●●.accdb")
ac.DoCmd.Quit
Set ac = Nothing
End Sub

Comments

[sazi]

複数開いているAccessはどのようにして開かれているのですか？手動？プログラムで？

[zelzel]

手動で複数開いてしまった場合に処理を実行するaccess以外の複数access一括終了させたいです。

[sazi]

出来ないとは思いませんが、色々ルールを考えたりしないと駄目ですし、そうなってしまう手順を見直した方が良いのではないかと思います。

[zelzel]

複数のaccessを同時に使用することが多く、メインとなるaccessで他のaccessを開いたり、閉じたりコントロールできないかと思い、今回質問させて頂きました。
ありがとうございました。

[sazi]

単にデータだけならメインのAccessにリンクテーブルしておけば、複数を開く必要はありませんけど、そういう事ではないんですよね？

[zelzel]

そうなんです。データだけではなく、フォームやレポートも使用しています。

[sazi]

無条件に終了させるんなら、バッチでも組んでおけば良いと思いますが、編集中だったら確認メッセージとかいう話になるなら、個別に対応するしかないと思いますけど。

[zelzel]

メインのaccessに下記コードを入力してみたところ、特定のaccessを閉じることができました。これを応用して複数指定したら、複数のaccessを閉じるれかも…と思いましたが、その特定のaccessが開いていないときに一度開いて閉じるみたいな動きになるため、現在閉じようとしているaccesが開いているのか判定する必要があるのかもしれません。

private sub コマンド1_Click
Dim ac As Object
Set ac= GetObject("●●●.accdb")
ac.DoCmd.Quit
Set ac = Nothing
End Sub

[sazi]

そういう話なら、起動するのをメイン側にしてあげれば（メイン側に起動用のメニューを作成するとか）良いのでは。

[sazi]

なお、ここでのコメントにするより、質問を編集する方が他の回答者の目につきやすくなると思います。

[zelzel]

アドバイスありがとうございます。質問を編集いたします。

Answer 1

ネットにあったのをコピペしてみて書いてみました。

Option Compare Database

Option Explicit

Private Declare PtrSafe Function EnumWindows Lib "user32.dll" _
                        (ByVal lpEnumFunc As LongPtr, _
                         ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32.dll" _
                        Alias "GetClassNameA" _
                        (ByVal hwnd As LongPtr, _
                         ByVal lpClassName As String, _
                         ByVal nMaxCount As LongPtr) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" _
                        Alias "SendMessageA" _
                        (ByVal hwnd As LongPtr, ByVal Msg As LongPtr, _
                         ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Const WM_CLOSE = &H10

Private mMyhWnd As Long

' コールバック関数
Public Function EnumWindowsProc(ByVal hwnd As Long, _
                         ByVal lParam As Long) As Long

    Dim strClassBuff    As String * 128
    Dim strClass        As String
    Dim lngRtnCode      As LongPtr
    
    lngRtnCode = GetClassName(hwnd, strClassBuff, Len(strClassBuff))
    strClass = Left(strClassBuff, InStr(strClassBuff, vbNullChar) - 1)
    If strClass = "OMain" Then
        If hwnd <> mMyhWnd Then
            SendMessage hwnd, WM_CLOSE, 0, 0
         End If
    End If
EnumPass:
    EnumWindowsProc = True
End Function


Sub CloseOtherAccess()
    mMyhWnd = Application.hWndAccessApp
    Dim lngRtnCode As LongPtr
    lngRtnCode = EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)
End Sub

CloseOtherAccessを実行すると、自分以外のAccessにクローズのメッセージを送ります。

これだけじゃ、ダイアログが出て閉じない場合があると思いますが
ただ、それを無理やり閉じるのは、どうかと思います。

という訳で残ってるのがあるかを判定して、それに応じた処理をするのがいいのでしょうか。

ちなみに
一応動作確認はしましたが、LongPtrとLongの扱いの違いが良くわかってないので
その辺りが不適切だと思ってます…

（参考にしたHP）
VBA 【コピペで使える！】別プロセスの特定Excelを一括終了する方法

EnumWindowsを使って別プロセスのExcelを取得してみた

Answer 2

プロセスのKillで良ければ、こちらのソースで可能と思います。
p.s. "MSACCESS"の部分はOSのバージョンで文字列違う可能性あります。
プロセスの強制終了ですので、Closeとは違います。
(環境:Access2007/32bit確認済み)

Option Explicit
'
Public Declare Function OpenProcess Lib "KERNEL32" ( _
       ByVal dwAccess As Long, _
       ByVal fInherit As Integer, _
       ByVal hObject As Long) As Long

Public Declare Function TerminateProcess Lib "KERNEL32" ( _
       ByVal hProcess As Long, _
       ByVal uExitCode As Long) As Long

Public Declare Function CloseHandle Lib "KERNEL32" ( _
       ByVal hObject As Long) As Long
        
Public Declare Function GetWindowThreadProcessId Lib "user32.dll" ( _
       ByVal hwnd As Long, lpdwProcessId As Long) As Long

Public Const SYNCHRONIZE = 1048576
Public Const NORMAL_PRIORITY_CLASS = &H20&
Public Const PROCESS_TERMINATE = &H1
   
Sub Test_Sample_Miniature()

    Dim objSet As Object
    Dim obj As Object
    Dim Locator As Object
    Dim Server As Object
    Dim lngProcessID As Long
    Dim hProcess As Long
    Dim MyAccessThreadID  As Long
    Dim MyAccessProcID As Long
    Dim MyAccesshWndID As Long
    
    'Get MyAccessProcID
    MyAccesshWndID = Application.hWndAccessApp
    MyAccessThreadID = GetWindowThreadProcessId(MyAccesshWndID, MyAccessProcID)
    If MyAccessThreadID = 0 Then
        MsgBox "Error Get ProcessID hWnd=" & MyAccesshWndID
        Exit Sub
    End If
    
    'Get ALL Access ProccesID
    Set Locator = CreateObject("WbemScripting.SWbemLocator")
    Set Server = Locator.ConnectServer
    Set objSet = Server.ExecQuery("Select * From Win32_Process")
    
    'Kill Other Access ProccesID
    For Each obj In objSet
        If InStr(obj.Name, "MSACCESS") > 0 Then
            '
            lngProcessID = obj.ProcessID
            If MyAccessProcID <> lngProcessID Then
                hProcess = OpenProcess(SYNCHRONIZE Or PROCESS_TERMINATE, True, lngProcessID)
                Call TerminateProcess(hProcess, 0&)
                Call CloseHandle(hProcess)
            End If
            '
        End If
    Next

    'Free Object
    Set objSet = Nothing
    Set obj = Nothing
    Set Server = Nothing
    Set Locator = Nothing
End Sub

Comments

[zelzel]

ご回答ありがとうございます。64bitではエラーが発生してしまいました。なんとか修正してみます。

[tosi]

強制終了でAccessのゴミファイルが残るので、xail2222様のSendMessageを使った方が良いです。
"Omain"は"OMain"とする必要があるかも知れません。

[xail2222]

"OMain"の方が正しそうですね。修正しました

Answer 3

一つの案として
タスク名の一覧から対象ファイルが開いているか確認して、見つかればタスクを終了する。

Private Sub コマンド1_Click()

Dim strTitle
Dim tgFilename As String
'閉じるファイル名
tgFilename = "Database1"
' ウィンドウタイトルから対象ファイルを閉じる。
Call GetProcessNames(tgFilename)

Stop

end sub

'https://www.tetsuyanbo.net/tetsuyanblog/24245 より
Public Function GetProcessNames(tgFilename As String)
' Wordアプリケーションオブジェクトを生成する
Dim objWordProcess As Object
Set objWordProcess = CreateObject("Word.Application")
' タスクリストから表示中のものだけ取得する
Dim objTask As Object
For Each objTask In objWordProcess.Tasks
Do
' 非表示のプロセスはスキップする
If objTask.Visible = False Then
Exit Do
End If
' プロセス名
Debug.Print objTask.Name
If objTask.Name Like "" & tgFilename & "" Then
MsgBox "起動しています。"
'タスクを終了する。
objTask.Close
End If
Loop While False
Next
' オブジェクトを破棄する
Set objWordProcess = Nothing
End Function

Comments

[zelzel]

遅くなりまして申し訳ございません。ご回答ありがとうございます。1つのaccessに対しては正常に動作いたしました。複数のaccessに対してはどういった記述の追加が必要になりますでしょうか？