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

EmptyRecycleBin


【ファイル名】EmptyRecycleBin.xlsm
【バージョン】Ver 1.0.0.0
【作成日】2021年04月30日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010
【ダウンロード】EmptyRecycleBin.zip
【説明】Windows APIのSHEmptyRecycleBinW関数で、ごみ箱を空にします。

メニュー


Windows APIでshell32.dllファイルのSHEmptyRecycleBinW関数で、ごみ箱を空にします。
【外部リンク】Windows > Apps > Win32 > API > The Windows Shell > Shellapi.h > SHEmptyRecycleBinW function

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="ごみ箱を空にします">
          <box id="Box1" boxStyle="horizontal">
            <button id="Default" label="ごみ箱を空" keytip="E" size="large" imageMso="EmptyRecycleBin" supertip="既定の操作で、ごみ箱を空にします。" onAction="onAction" />
            <button id="NoConfirm" label="確認しない" keytip="C" size="large" imageMso="EmptyRecycleBin" supertip="確認しないで、ごみ箱を空にします。" onAction="onAction" />
            <button id="NoProgressUI" label="進捗状況しない" size="large" keytip="P" imageMso="EmptyRecycleBin" supertip="進捗状況ダイアログを表示しません。" onAction="onAction" />
            <button id="NoSound" label="無音" keytip="S" size="large" imageMso="EmptyRecycleBin" supertip="終了時に効果音を鳴らしません。" onAction="onAction" />
          </box>
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上

Module1
Option Explicit

#If Win64 Then
' https://docs.microsoft.com/en-us/windows/win32/api/shellapi/nf-shellapi-shemptyrecyclebinw
  Private Declare PtrSafe Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinW" ( _
                  ByVal hwnd As LongPtr, _
                  ByVal pszRootPath As LongPtr, _
                  ByVal dwFlags As LongPtr) As Long
#Else
  Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinW" ( _
                  ByVal hwnd As Long, _
                  ByVal pszRootPath As Long, _
                  ByVal dwFlags As Long) As Long
#End If

Private Const SHERB_NOCONFIRMATION = &H1 ' 削除を確認しません。
Private Const SHERB_NOPROGRESSUI = &H2 ' 進捗状況ダイアログを表示しません。
Private Const SHERB_NOSOUND = &H4 ' 終了時に効果音を鳴らしません。

Private Const S_OK = 0 ' 正常終了

Private rbRibbonUI As IRibbonUI   ' リボン

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

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  On Error GoTo ErrorHandler ' エラー処理ルーチン
  
  Select Case control.ID
    Case "Default" ' 既定の操作で、ごみ箱を空にします。
      If SHEmptyRecycleBin(0, StrPtr(vbNullString), 0) <> S_OK Then
        MsgBox Prompt:=control.ID & "ごみ箱を空にできません。", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      End If
    Case "NoConfirm" ' 確認しないで、ごみ箱を空にします。
      If SHEmptyRecycleBin(0, StrPtr(vbNullString), SHERB_NOCONFIRMATION) <> S_OK Then
        MsgBox Prompt:=control.ID & "ごみ箱を空にできません。", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      End If
    Case "NoProgressUI" ' 進捗状況ダイアログを表示しません。
      If SHEmptyRecycleBin(0, StrPtr(vbNullString), SHERB_NOPROGRESSUI) <> S_OK Then
        MsgBox Prompt:=control.ID & "ごみ箱を空にできません。", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      End If
    Case "NoSound" ' 終了時に効果音を鳴らしません。
      If SHEmptyRecycleBin(0, StrPtr(vbNullString), SHERB_NOSOUND) <> S_OK Then
        MsgBox Prompt:=control.ID & "ごみ箱を空にできません。", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      End If
    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
このページの上