HOME > エクセルVBA > サンプル > Shell

Shell


【ファイル名】Shell.xlsm
【バージョン】Ver 1.0.0.0
【作成日】2021年04月29日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010
【ダウンロード】Shell.zip
【説明】Shellのサンプルです。(ShutdownWindows、Suspendなどは実行できません。)
メニュー

下記でVBAの参照設定なしで、ShellのActiveXオブジェクトを作成します。
  Set Shell = CreateObject("Shell.Application")

Shellの型を参照するには「ツール」の「参照設定」のメニューで、「Microsoft Shell Controls And Automation」をチェックし、「OK」ボタンを実行します。

【外部リンク】Windows / アプリ / Win32 / デスクトップテクノロジ / デスクトップ環境 / Windows シェル / Shell object

customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル" insertBeforeMso="TabHome" keytip="S">
        <group id="Group1" label="Shell">
          <box id="Box1" boxStyle="horizontal">
            <menu id="WindowMenu" label="ウィンドウ(&amp;W)" itemSize="normal" imageMso="WindowUnhide" size="normal" keytip="M">
              <button id="CascadeWindows" label="CascadeWindows(&amp;C)" supertip="ウィンドウを重ねて表示します。" imageMso="WindowsCascade" onAction="onAction" />
              <button id="TileHorizontally" label="TileHorizontally(&amp;H)" supertip="ウィンドウを上下に並べて表示します。" imageMso="WindowsTileHorizontally" onAction="onAction" />
              <button id="TileVertically" label="TileVertically(&amp;V)" supertip="ウィンドウを左右に並べて表示します。" onAction="onAction" />
              <button id="ToggleDesktop" label="ToggleDesktop(&amp;T)" supertip="すべてのウィンドウを最小化して、デスクトップを表示します。" onAction="onAction" />
<!--
              <button id="UndoMinimizeALL" label="UndoMinimizeALL(&amp;U)" supertip="最小化したウィンドウを元に戻します。" onAction="onAction" />
-->
            </menu>

            <menu id="ExecMenu" label="実行・設定" itemSize="normal" imageMso="ReadingPrevPageRtl" size="normal" keytip="S">
              <button id="ControlPanelItem" label="ControlPanelItem(&amp;C)" supertip="「コントロール パネル」の「ディスプレイ」を表示します。" onAction="onAction" />
              <button id="Explore" label="Explore(&amp;E)" supertip="Windowsフォルダをエクスプローラーで開きます。" onAction="onAction" />
              <button id="FileRun" label="FileRun(&amp;R)" supertip="「ファイル名を指定して実行」を起動します。" onAction="onAction" />
              <button id="FindComputer" label="FindComputer(&amp;C)" supertip="コンピュータの検索を表示します。" onAction="onAction" />
<!--
              <button id="FindFiles" label="FindFiles(&amp;F)" supertip="ファイルの検索を表示します。(Windows XP)" onAction="onAction" />
              <button id="FindPrinter" label="FindPrinter(&amp;P)" supertip="プリンターの検索を表示します。" onAction="onAction" />
-->
              <button id="Help" label="Help(&amp;H)" supertip="ヘルプを表示します。" imageMso="Help" onAction="onAction" />
              <button id="Open" label="Open(&amp;O)" supertip="ドキュメントのフォルダをエクスプローラーで表示します。" onAction="onAction" />
              <button id="SearchCommand" label="SearchCommand(&amp;S)" supertip="SearchCommandを実行します。" onAction="onAction" />
<!--
              <button id="ServiceStart" label="ServiceStart(&amp;V)" supertip="Messengerのサービスを開始します。" onAction="onAction" />
              <button id="ServiceStop" label="ServiceStop(&amp;I)" supertip="Messengerのサービスを停止します。" onAction="onAction" />
-->
              <button id="SetTime" label="SetTime(&amp;R)" supertip="「日付と時刻」の設定を表示します。" imageMso="DateAndTimeInsert" onAction="onAction" />
              <button id="ShellExecute" label="ShellExecute(&amp;X)" supertip="メモ帳のウインドウのサイズを最大化して実行します。" onAction="onAction" />
              <button id="TrayProperties" label="TrayProperties(&amp;T)" supertip="「タスクバーの設定」を表示します。" onAction="onAction" />
              <menuSeparator id="menuSeparator1" />
              <button id="ShutdownWindows" label="ShutdownWindows(&amp;D)" supertip="Winodwsを終了します。" onAction="onAction" />
              <button id="Suspend" label="Suspend(&amp;N)" supertip="Winodwsをサスペンドします。" onAction="onAction" />
            </menu>

            <menu id="ShowMenu" label="表示" itemSize="normal" imageMso="Club" size="normal" keytip="D">
              <button id="BrowseForFolder" label="BrowseForFolder(&amp;B)" supertip="フォルダの参照のダイアログを表示します。" onAction="onAction" />
              <button id="ExplorerPolicy" label="ExplorerPolicy(&amp;E)" supertip="レジストリのHKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\ExplorerキーのNoDriveTypeAutoRunの値を表示します。" onAction="onAction" />
              <button id="GetSetting" label="GetSetting(&amp;G)" supertip="GetSetting(ssfSHOWALLOBJECTS)で表示します。" onAction="onAction" />
              <button id="GetSystemInformation" label="GetSystemInformation(&amp;S)" supertip="マウスのダブルクリックの時間を表示します。" onAction="onAction" />
              <button id="IsRestricted" label="IsRestricted(&amp;R)" supertip="レジストリのHKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies\systemキーのundockwithoutlogonの値をします。" onAction="onAction" />
              <button id="IsServiceRunning" label="IsServiceRunning(&amp;R)" supertip="IsServiceRunningで引数のThemesの結果を表示します。" onAction="onAction" />
              <button id="Namespace" label="Namespace(&amp;N)" supertip="Namespace(ssfPERSONAL)の結果を表示します。" onAction="onAction" />
            </menu>

            <menu id="OtherMenu" label="その他" itemSize="normal" imageMso="Heart" size="normal" keytip="O">
              <button id="EjectPC" label="EjectPC(&amp;E)" supertip="ドッキング ステーションからコンピュータを除きます。" onAction="onAction" />
<!--
              <button id="RefreshMenu" label="RefreshMenu(&amp;R)" supertip="スタートメニューの更新します。(Windows XP)" onAction="onAction" />
-->

<!--
              <button id="WindowsSecurity" label="WindowsSecurity(&amp;W)" supertip="WindowsSecurityを実行します。" onAction="onAction" />
-->
              <button id="WindowSwitcher" label="WindowSwitcher(&amp;S)" supertip="タスクを切り替えます。" imageMso="WindowsSwitch" onAction="onAction" />
            </menu>

          </box>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上

FunctionModule
Option Explicit
' Shellの型を参照するには「ツール」の「参照設定」のメニューで、「Microsoft Shell Controls And Automation」をチェックし、「OK」ボタンを実行します。
' "C:\Windows\System32\shell32.dll"

' フォルダのダイアログを表示してフォルダ名を取得します。キャンセルしたら空の文字列を返します。
  Dim Shell ' As Shell32.Shell
Public Function GetBrowseForFolder(Optional Prompt As String = "フォルダを選択してください。", _
                                   Optional RootFolder As Shell32.ShellSpecialFolderConstants = ssfDESKTOP) As String
  Const BIF_EDITBOX As Long = &H10
' Shell.BrowseForFolder method
' https://docs.microsoft.com/ja-jp/windows/win32/shell/shell-browseforfolder
  Dim Shell ' As Shell32.Shell
  Dim Folder ' As Shell32.Folder3
  
  GetBrowseForFolder = ""
  Set Shell = CreateObject("Shell.Application")
  Set Folder = Shell.BrowseForFolder(0&, Prompt, BIF_EDITBOX, RootFolder)
  If Not Folder Is Nothing Then
    If Folder.Items.Item Is Nothing Then
      GetBrowseForFolder = Folder.Self.Path
    Else
      GetBrowseForFolder = Folder.Items.Item.Path
    End If
  End If
  
  Set Folder = Nothing
  Set Shell = Nothing
End Function

Sub Test_GetSystemInformation()
' IShellDispatch2.GetSystemInformation method
' https://docs.microsoft.com/ja-jp/windows/win32/shell/ishelldispatch2-getsysteminformation
  Dim Shell ' As Shell32.Shell
  Dim msg As String
  
  Set Shell = CreateObject("Shell.Application")
  msg = "DirectoryServiceAvailable" & vbTab & Shell.GetSystemInformation("DirectoryServiceAvailable")
  msg = msg & "DoubleClickTime" & vbTab & Shell.GetSystemInformation("DoubleClickTime")
  msg = msg & "ProcessorLevel" & vbTab & Shell.GetSystemInformation("ProcessorLevel")
  msg = msg & "ProcessorSpeed" & vbTab & Shell.GetSystemInformation("ProcessorSpeed")
  msg = msg & "ProcessorArchitecture" & vbTab & Shell.GetSystemInformation("ProcessorArchitecture")
  msg = msg & "PhysicalMemoryInstalled" & vbTab & Shell.GetSystemInformation("PhysicalMemoryInstalled")
  msg = msg & "IsOS_Professional" & vbTab & Shell.GetSystemInformation("IsOS_Professional")
  msg = msg & "IsOS_Personal" & vbTab & Shell.GetSystemInformation("IsOS_Personal")
  msg = msg & "IsOS_DomainMember" & vbTab & Shell.GetSystemInformation("IsOS_DomainMember")
  
  MsgBox Prompt:=msg, Buttons:=vbInformation, Title:="情報"
End Sub
このページの上

Module1
Option Explicit
' Shellの型を参照するには「ツール」の「参照設定」のメニューで、「Microsoft Shell Controls And Automation」をチェックし、「OK」ボタンを実行します。
' "C:\Windows\System32\shell32.dll"

Private rbRibbonUI As IRibbonUI   ' リボン

Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理
  Set rbRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
  rbRibbonUI.Invalidate ' リボンの表示を更新します。
End Sub

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  Const ssfSHOWALLOBJECTS = 1
  Const ssfPERSONAL = &H5&
' Shell.BrowseForFolder method
' https://docs.microsoft.com/ja-jp/windows/win32/shell/shell-browseforfolder
  Dim Shell ' As Shell32.Shell
  Dim Folder ' As Shell32.Folder3
  
  Set Shell = CreateObject("Shell.Application")
  On Error GoTo ErrorHandler ' エラー処理ルーチン
  Select Case control.ID
    Case "BrowseForFolder" ' フォルダの参照のダイアログを表示します。
      MsgBox FunctionModule.GetBrowseForFolder()
    Case "CascadeWindows" ' ウィンドウを重ねて表示します。
      Shell.CascadeWindows
    Case "ControlPanelItem" ' 「コントロール パネル」の「ディスプレイ」を表示します。
      Shell.ControlPanelItem "desk.cpl"
    Case "EjectPC" ' ドッキング ステーションからコンピュータを除きます。
      Shell.EjectPC
    Case "Explore" ' Windowsフォルダをエクスプローラーで開きます。
      Shell.Explore "c:\windows"
    Case "ExplorerPolicy"
' HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer
      MsgBox "NoDriveTypeAutoRun: " & Shell.ExplorerPolicy("NoDriveTypeAutoRun")
    Case "FileRun" ' 「ファイル名を指定して実行」を起動します。
      Shell.FileRun
    Case "FindComputer" ' コンピュータの検索を表示します。
      Shell.FindComputer
    Case "FindFiles" ' ファイルの検索を表示します。(Windows XP)
      Shell.FindFiles
    Case "FindPrinter" ' プリンターを検索します。
      Shell.FindPrinter
' https://docs.microsoft.com/ja-jp/windows/win32/shell/shell-getsetting
    Case "GetSetting" '
      MsgBox Shell.GetSetting(ssfSHOWALLOBJECTS)
    Case "GetSystemInformation" ' マウスのダブルクリックの時間を表示します。
      MsgBox "DoubleClickTime: " & Shell.GetSystemInformation("DoubleClickTime")
    Case "Help" ' ヘルプを表示します。
      Shell.Help
    Case "IsRestricted" ' レジストリのHKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies\systemキーのundockwithoutlogonの値をします。
' HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies\
      MsgBox "undockwithoutlogon: " & Shell.IsRestricted("system", "undockwithoutlogon")
    Case "IsServiceRunning" '
      MsgBox "Themes: " & Shell.IsServiceRunning("Themes")
    Case "MinimizeAll" '
      Shell.MinimizeAll
    Case "Namespace" '
' https://docs.microsoft.com/ja-jp/windows/win32/api/shldisp/ne-shldisp-shellspecialfolderconstants
      MsgBox Shell.Namespace(ssfPERSONAL)
    Case "Open" '
      Shell.Open ssfPERSONAL
    Case "RefreshMenu" '
      Shell.RefreshMenu ' スタートメニューの更新します。(Windows XP)
    Case "SearchCommand" '
      Shell.SearchCommand
    Case "ServiceStart" ' Messengerのサービスを開始します。
      Shell.ServiceStart "Messenger", True
    Case "ServiceStop" ' Messengerのサービスを停止します。
      Shell.ServiceStop "Messenger", True
    Case "SetTime" '
      Shell.SetTime ' 「日付と時刻」の設定を表示します。
    Case "ShellExecute" '
      Shell.ShellExecute "Notepad.exe", "", "", "open", 3 ' メモ帳のウインドウのサイズを最大化して実行します。
    Case "ShowBrowserBar" '
      Shell.ShowBrowserBar "{EFA24E62-B078-11d0-89E4-00C04FC9E26E}", True ' 実行できません。
    Case "ShutdownWindows" ' Winodwsを終了します。
      If MsgBox(Prompt:="Winodwsを終了しますか?", Buttons:=vbYesNo + vbInformation, Title:="情報") = vbNo Then Exit Sub
      Shell.ShutdownWindows ' Windows10では実行しません。
    Case "Suspend" ' Winodwsをサスペンドします。
      If MsgBox(Prompt:="Winodwsをサスペンドしますか?", Buttons:=vbYesNo + vbInformation, Title:="情報") = vbNo Then Exit Sub
      Shell.Suspend ' Windows10では実行しません。
    Case "TileHorizontally" ' ウィンドウを上下に並べて表示します。
      Shell.TileHorizontally
    Case "TileVertically" '
      Shell.TileVertically ' ウィンドウを左右に並べて表示します。
    Case "ToggleDesktop" ' すべてのウィンドウを最小化して、デスクトップを表示します。
      Shell.ToggleDesktop
    Case "TrayProperties" '
      Shell.TrayProperties ' 「タスクバーの設定」を表示します。
    Case "UndoMinimizeALL" ' 最小化したウィンドウを元に戻します。
      Shell.UndoMinimizeALL
    Case "Windows" '
      MsgBox Prompt:=Shell.Windows(), Buttons:=vbInformation, Title:="情報"
    Case "WindowsSecurity" '
      Shell.WindowsSecurity
    Case "WindowSwitcher" ' タスクを切り替えます。
      Shell.WindowSwitcher
    Case Else
      Beep ' 警告音
      MsgBox Prompt:=control.ID & "の処理がありません!", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      Exit Sub
  End Select
  Exit Sub
'-------------------------------------------------------------------------------------------------------------------------
ErrorHandler: ' エラー処理ルーチン
  Beep ' 警告音
  MsgBox Prompt:="エラー番号:" & Err.Number & vbCrLf & Err.Description, Buttons:=vbCritical + vbSystemModal, Title:="エラー"
End Sub
このページの上