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

Accepted Answer

ネットにあったのをコピペしてみて書いてみました。

```VBA
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を一括終了する方法](https://mmm-program.com/vba-other-excel-close/)

[EnumWindowsを使って別プロセスのExcelを取得してみた](https://www.excel-chunchun.com/entry/enumwindows-excel-vba)

Answer

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

Answer

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

関連した質問