030104

タイトル	ファイルをごみ箱に送る
対象言語	VB4.0, Access95以降
動作確認ＯＳ	Windows95,98,NT4.0
使用関数	SHFileOpration
改築日	1999/04/21(1998/01/05)
Source Download

ファイル・フォルダをごみ箱に移動、
直接削除をします。

フォルダの場合、コピー元のフォルダ内のサブフォルダも全て
ごみ箱に移動、直接削除出来ます。
設定によっては処理中のダイアログ表示や削除確認
等も表示ができます。

また、この関数はファイルコピーや移動、ファイル名
変更などの機能をもった高機能関数です。

1. フォームを作成しコマンドボタン（Command1）を貼り付けてください。

Option Explicit

Private Sub Command1_Click()

　　 Dim FileList(2) As String
　　 Dim Files As String
　　 Dim tmp As String
　　 Dim i As Integer
　　 Dim fl As Integer

'テストファイルをテンポラリフォルダに作成する
　　 tmp = Environ("temp") 'Tempフォルダ取得
　　 FileList(1) = tmp & "\Test1.txt"
　　 FileList(2) = tmp & "\Test2.txt"

　　 For i = 1 To 2
　　　　 fl = FreeFile()
　　　　 Open FileList(i) For Output As #fl
　　　　 Close #fl
　　 Next

'複数ファイルを指定する時は、ファイル名を　chr$(0)でつなげる
　　 Files = vbNullString
　　 For i = 1 To 2
　　　　 Files = Files & FileList(i) & vbNullChar
　　 Next

'複数ファイルをごみ箱に送ります
　　 Call Y_FileDelete(Me.hWnd, Files, 0)

End Sub

3.モジュールウインドウを作成し、下のソースを入力してください。

Option Explicit

'ファイル操作
Declare Function SHFileOperation Lib "shell32.dll" (lpFileOp As SHFILEOP) As Long

Type SHFILEOP
　　 hWnd As Long 'オナーウィンドウのハンドル
　　 wFunc As Long '実行コマンド
　　 pFrom As String '操作元ファイル名等
　　 pTo As String '操作先ファイル名等
　　 fFlags As Integer '処理フラグ
　　 fAnyOperationsAborted As Long '処理中にキャンセルした時1がセットされる
　　 hNameMappings As Long 'ファイル名マッピングオブジェクトハンドル
　　 lpszProgressTitle As String 'ダイアログのタイトル名(FOF_SIMPLEPROGRESS指定時)
End Type

Public Const FO_DELETE = &H3 'ファイル削除
Public Const FOF_ALLOWUNDO = &H40 'ごみ箱に送る
Public Const FOF_NOCONFIRMATION = &H10 '上書き確認せずに実行
Public Const FOF_SILENT = &H4 '進行状況ダイアログを表示しない

Public Sub Y_FileDelete(hWnd As Long, FromFiles As String, Sw As Integer)
'*******************************************************************
'機能 : SHFileOperation関数を呼び出し、ファイルをごみ箱に送るか削除する
'引数　: hWnd　　　= オーナーウィンドウハンドル
'　　　 FromFiles = 削除するファイルのフルパス名
'　　　　Sw　　　　 = 0:ごみ箱に送る
'　　　　　　　　　　 = 1:直接削除
'備考　: FromFilesにフォルダを指定すると、その階層下のサブフォルダ
' も処理対象になります。
'*******************************************************************

　　 Dim ShellOp As SHFILEOP
　　 Dim longret As Long
　　 Dim flg As Integer

　　 If Sw = 0 Then
　　　　 flg = FOF_ALLOWUNDO 'ごみ箱に送る
　　 Else
　　　　 flg = 0 '直接削除する
　　 End If

　　' flg = flg + FOF_SILENT '進行状況ダイアログを表示しない
　　' flg = flg + FOF_NOCONFIRMATION '削除確認しない

　　 With ShellOp
　　　　 .hWnd = 0&
　　　　 .wFunc = FO_DELETE
　　　　 .pFrom = FromFiles
　　　　 .fFlags = flg
　　 End With

'ファイル操作
　　 longret = SHFileOperation(ShellOp)

End Sub