#371 ファイルをごみ箱に入れる方法(Killステートメントの代替) VBA、API

VBAを使ってディスク上のファイルを削除するには、通常「Killステートメント」を使います。一方、WindowsAPI(SHELL32.DLLのSHFileOperation関数)を使うと、ファイルの完全削除ではなく、エクスプローラでの削除のように、そのファイルを"ごみ箱に移動"させることができます。あとで復活可能にしたいファイル削除処理においては、これをKillステートメントの代替として利用するとよいでしょう。

※ここではKillステートメントの代替ということで、エクスプローラのような確認メッセージは表示させません。表示させたい場合には、「#113 エクスプローラ風のファイル削除」を参考にしてください。


このような処理を行うには、まず標準モジュールに次のようなプログラムを書きます。「FileToTrush」はオリジナルのプロシージャです。

'Windows APIの宣言
Private Type SHFILEOPSTRUCT
  hwnd As Long
  wFunc As Long
  pFrom As String
  pTo As String
  fFlags As Integer
  fAnyOperationsAborted As Long
  hNameMappings As Long
  lpszProgressTitle As String
End Type
Private Declare Function SHFileOperation Lib "SHELL32.DLL" Alias _
                      "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FO_DELETE = &H3
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_ALLOWUNDO = &H40

Public Function FileToTrush(strFilePath As String) As Boolean
'概要 指定したファイルをごみ箱に移動する
'引数 strFilePath:移動するファイルのフルパス
'返値 成功時 True、失敗時 False

  Dim stShellOp As SHFILEOPSTRUCT

  With stShellOp
    'Accessのハンドルをセット
    .hwnd = Application.hWndAccessApp
    '削除モードを指定
    .wFunc = FO_DELETE
    '削除ファイルのフルパスをセット
    .pFrom = strFilePath
    'ごみ箱移動と確認メッセージ無しのフラグをセット
    .fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
  End With

  'ごみ箱移動を実行
  If SHFileOperation(stShellOp) = 0 Then
    FileToTrush = True
  Else
    FileToTrush = False
  End If

End Function


これを実際に使うには、次のようなコードを記述します。

例1:
  'とにかくごみ箱移動を試みる(Sub的呼び出し)
  FileToTrush "c:\test.txt"


例2:
  'ごみ箱移動できなければ強制削除(Function的呼び出し)
  If Not FileToTrush("c:\test.txt")
    Kill "c:\test.txt"
  end if 

| Index | Prev | Next |

この情報は参考になりましたか?、問題は解決しましたか?、もしまだなら......
T'sWareのワンポイトテクニカルアドバイスをご利用ください。3000円/件〜でご支援します。
スタンドアロンからSQL Server対応まで、オーダーメイドのシステムを短納期・安価でお届けします
 

Copyright © T'sWare All rights reserved