野口香社会保険労務士事務所

群馬県にある社会保険労務士事務所のページです。

VBAで開いたフォルダをVBAで閉じるには

Yahoo!知恵袋で次のような質問がありました。

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12265854167

前月に知恵袋で教えていただき、outlook vbaで添付ファイルを任意のフォルダへ保存するところまではできました。 その保存されたフォルダを開けて、保存されているかどうかを確認する為shellを使ってフォルダを表示しましたが、確認後にフォルダを閉じたいのですがどこにどう書けばいいのかわかりませんので、教えていただけますでしょうか。 ちなみにフォルダを閉じる前にmsgboxでOK？表示のうえ、OKボタンを押したらフォルダが閉じるという動きにしたいです。 よろしくお願いいたします。

https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12265854167
Sub openFolder(path As String)
Shell "C:\Windows\Explorer.exe " & path, vbNormalFocus
End Sub
'----------------
Sub test_openFolder()
Call openFolder("任意のフォルダ保存先")
End Sub

Shellで起動しているのに戻り値を用意していないから、閉じるときに指定できなくて困っているだけで、

lPtr = Shell("C:\Windows\Explorer.exe " & path, vbNormalFocus)

とすれば簡単じゃね？と思ったのですが、ことはそう簡単ではありました。

目次

Shell戻値で閉じるやり方

最初に考えたのが、Shell戻値で閉じるやり方です。

こんな感じ。

Sub openFolder(path As String)
    Dim lPtr As Long
    Dim iMsg As Integer

    lPtr = Shell("C:\Windows\Explorer.exe " & path, vbNormalFocus)

    iMsg = MsgBox("終了させますか", vbYesNo + vbDefaultButton2 + vbExclamation)
    If iMsg = vbYes Then
        
        AppActivate lPtr
        VBA.Interaction.SendKeys "%{F4}"
    
    End If
End Sub
'----------------
Sub test_openFolder()
Call openFolder("C:\temp")
End Sub

あらかじめShellの戻り値を把握しておいて、AppActivateでアクティブにした後、SendKeyでAlt＋F4で終了するやり方です。

このやり方だと、エラーになりました。

実行時エラーが出ました。

エラーになった個所はここ。

AppActivateでエラーになりました。

理由はよく分かりません。引数の指定が悪かったかとCstrでlPtrを文字列にしてみたけど、やはりエラーでした。

Outlookだからか？と思い、ExcelVBAでも同じコードを試してみたけど、結果は同じ、エラーになりました。

こんなご意見もあり、

https://kimuarekore.hatenablog.com/entry/20170420/1492674881

AppActivateというのは確実性のないものだというだけは分かりました。

うまくいかない

いろいろ試しましたがうまくいきません。

SendMessageを使うやり方

取得したハンドルでウィンドウを閉じたいのですが。。

こちら↑で紹介されていたSendMessageを使うやり方を試しました。

Option Explicit
Declare PtrSafe Function SendMessage Lib "user32.dll" _
    Alias "SendMessageA" _
    (ByVal hwnd&, _
    ByVal wMsg&, _
    ByVal wParam&, _
    ByVal lParam&) As Long
Public Const SC_CLOSE = &HF060
Public Const WM_SYSCOMMAND = &H112

Sub openFolder(path As String)
    Dim lPtr As Long
    Dim iMsg As Integer
    
    lPtr = Shell("C:\Windows\Explorer.exe " & path, vbNormalFocus)
    
    iMsg = MsgBox("終了させますか", vbYesNo + vbDefaultButton2 + vbExclamation)
    
    If iMsg = vbYes Then
        Call SendMessage(lPtr, WM_SYSCOMMAND, SC_CLOSE, 0)
    End If
End Sub
'--------------
Sub test_openFolder()
Call openFolder("C:\temp")
End Sub

これはエラーにはならないけど、フォルダは開いたままでした。orz

https://teratail.com/questions/36610

↑こちらの方法2のやり方も、結局はSendMessageでして、うまくいきませんでした。

Shell.Applicationを使うやり方

こちら↓で紹介されていたShell.Applicationを使うやり方も試しました。

【マクロ】開いているフォルダを閉じる方法（サブフォルダも）

Sub openFolder(path As String)
    Dim iMsg As Integer
    Dim w As Object
    Dim Shl As Object
    
    Set Shl = CreateObject("Shell.Application")
    
    Shell "C:\Windows\Explorer.exe " & path, vbNormalFocus
    
    iMsg = MsgBox("終了させますか", vbYesNo + vbDefaultButton2 + vbExclamation)
    
    If iMsg = vbYes Then
 
        For Each w In Shl.Windows
            If (InStr(TypeName(w.document), "IShellFolderView") > 0) Then w.Quit
        Next w
    End If
End Sub
'---------
Sub test_openFolder()
Call openFolder("C:\temp")
End Sub

これを実行したら、やはりエラーにはならないけどフォルダは開いたままでした。

しかし、途中でローカルウィンドウで確認したら、w.documentのTypenameは確かにIShellFolderViewDual3となっていたので、w.Quitがうまくいっていないことが分かりました。

原因は不明です。

うまくいった方法

結局うまくいったのはプロセスからフォルダエクスプローラーを検索して強引にプロセスをkillしてしまう方法だけでした。

Excel VBA – Excel VBA：複数の開いているエクスプローラーウィンドウから特定のエクスプローラーウィンドウを閉じる

ExcelVBAとなっているけど、Outlookでもいけました。

Sub openFolder(path As String)
    Dim objWMIcimv2 As Object, objProcess As Object, objList As Object
    Dim intError As Integer
    Dim iMsg As Integer
    
    Shell "C:\Windows\Explorer.exe " & path, vbNormalFocus
    
    iMsg = MsgBox("終了させますか", vbYesNo + vbDefaultButton2 + vbExclamation)
    If iMsg = vbYes Then
 
        Set objWMIcimv2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
        Set objList = objWMIcimv2.ExecQuery("select * from win32_process where name='explorer.exe'")
        For Each objProcess In objList
            intError = objProcess.Terminate
            If intError <> 0 Then Exit For
        Next
    End If
    
    Set objWMIcimv2 = Nothing
    Set objList = Nothing
    Set objProcess = Nothing
End Sub
'-----
Sub test_openFolder()
Call openFolder("C:\temp")
End Sub

これで実行すると、指定のフォルダはもちろん、すでに開いておいたフォルダも全部閉じてしまいます。

開いているフォルダのタイトルとかWindowHandleをゲットすればさらに細かくフォルダを指定して閉じることができるでしょうけど、これって結局タスクマネージャーを立ち上げて強制終了しているのと同じな訳で、これを組み込むのはどうなのよ・・・・と思ったので知恵袋に回答するのはやめました。

タスクマネージャー

まとめ

対象がOutlookだったのもありますが、今回は全然うまくいかなかったなという挫折感が大きいです。

しかし、フォルダを閉じるのをVBAでやる必要性って何だろうと考えてしまいました。

こんな↓意見もありました。

https://oshiete.goo.ne.jp/qa/4540635.html

５０００ファイルを溜め込む処理（どういう間隔で？　１日で？）を見直すのがよいかもしれませんし、また、目視で５０００ファイル全てを確認するのではないでしょうから、フォルダを開かずに目的のファイルだけを直接開けばよいかもしれません。

やはりフォルダを開かざるを得ないとしても、キャッシュを有効にするためにはフォルダを開いて閉じなくてもスクリプトでフォルダ内を空読みすればよさそうな気がします。

一般論として、ＯＳへの要求（本件の場合フォルダを開いて閉じる）は避けられるものなら避けた方がシステム全体の性能のためには良いと思います。

https://oshiete.goo.ne.jp/qa/4540635.html

これは、

Win2kサーバーをファイルサーバーとして利用しているのですが、
１つのフォルダ内に５０００ファイルほどをためてしまう構造になっています。（サーバの他のフォルダからスクリプト（？）のようなものを使って、自動的にそのフォルダにデータがたまるようになっています。）
　そのためなのかは、よくわからないのですが、そのフォルダをサーバー上で開くと、数十秒近く時計マークがでてなかなかフォルダ内のデータを確認できません。一度そのフォルダを開くと、その後は瞬時に開くようになります。（キャッシュの問題では？と同僚から言われております。）
他の処理にも何となくですがレスポンスが悪くなっているような気がします
構造的な問題があるかもしれないのですが、このレスポンスの悪さを解消するために、データを移動させるスクリプトにデータ移動後、フォルダを開いて、閉じるという内容を加えたいと思っております。

https://oshiete.goo.ne.jp/qa/4540635.html

という目的で自動でフォルダを閉じる機能を実装したいという質問者に対するアドバイスなんですが、確かに自動でフォルダを閉じるより、フォルダを空読みする方がシステムに対する負荷は小さいですよね。