Excelからほかのファイルを直接削除する方法


Excel VBAあらかると

 ブックやワード文書、テキストなどの『ファイルをExcelから直接削除する方法』 が今回のテーマです。

フォルダー「マイドキュメント」に放置されたブックやワード文書を整理した〜い!
WebMambowに切実な声が届いた。

早々に、エクスプローラ、またはマイコンピュータからフォルダー「マイドキュメント」を開いて削除したいファイルをマウスカーソルでポイントし右クリックしてショートカットメニューの削除を選択 云々...  を返信したのですが、操作が面倒とのことで他の削除方法を問われた。

Windowsの基本操作を面倒と表現するのでは、DOSプロンプトからDOSコマンドDel命令を打鍵させての削除方法はそれこそ論外である!
そうであれば「Excelからフォルダー内のファイルを閲覧して削除する」ことも面白いかと考え作ったものが、今回公開するソースコードになります。
公開するソースコードは、本物を少しカスタマイズしていますがほとんど原形です。

※この削除処理は、自己責任に基づき閲覧・実行願います。


 シナリオ  (仕様書)
削除したい場所(フォルダー)を指定することにより、そのフォルダー内に保存されているファイルが表示され表示されたファイルの一覧から削除したいファイルを選択することで対象ファイルの削除を実行します。


 実行画面
実行は、ブック名「ワークシート分離.xls」シート名「main」の分離ボタンをクリックします。
 
@  ボタンをクリックし削除対象となるファイルが保存されているフォルダーを指定します。

A @でフォルダーを選択するとその中に保存されているファイルが一覧されます。

B ファイル名の右横の項目「削除」欄に1を入力することにより削除対象ファイルの判断となります。

C  実行ボタンをクリックし削除を行います。


尚、ここでの削除処理はゴミ箱のように一時退避はしません。直接削除されますので削除実行には十分に注意し試して下さい。


 マクロコード
 標準モジュールへ記述
の実行ソース
Sub fol()

'フォルダを指定する

'実行を確認する。
If MsgBox("ファイル削除を実行します。よろしいですか?", vbYesNo + vbQuestion, "Mambow") = vbNo Then
  MsgBox ("処理を中断します。")
  Exit Sub
End If

'前に一覧表示したファイルの消去処理
l_end = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row     '一覧の最終行を取得

If l_end > 9 Then                             '明細行の先頭行以上の時に消去実行
  Range("B9:F" & l_end).Select
  Selection.ClearContents
  Range("F9").Select

End If

'「ファイル開く」ダイヤログボックスの表示を実行
' 削除対象とするフォルダー名(場所)を取得するために、 [ファイルを開く]ダイアログ ボックスを表示します。
' ダイアログ ボックスで指定したファイルは、実際には開かれません。
opn = Application.GetOpenFilename
fdname = CurDir

Cells(6, 4) = fdname                            '選択したフォルダー場所をセル表示

flname = Dir(fdname & "\*.*", vbNormal)                'フォルダー内の全ファイル名を取得

If flname = "" Then
  MsgBox "ファイルがありません。"

Else
  i = 9

  Do While flname <> ""                          'ファイル名が空欄の時抜け出し

    Cells(i, 2).Value = i - 8                        '行数を表示
    Cells(i, 5).Value = flname                       'ファイル名を表示

    i = i + 1
    flname = Dir()                             '次のファイル名を取得

  Loop

End If

Cells(9, 6).Select                                '明細先頭行項目「削除」をフォーカス

End Sub


の実行ソース
Sub kil()

' ファイルの削除実行

If MsgBox("削除します。よろしいですか?", vbYesNo + vbQuestion, "Mambow") = vbNo Then
  MsgBox ("処理を中断します。")
  Exit Sub
End If

b = 0

l_end = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
If l_end < 9 Then
  MsgBox "フォルダー内が空?? 処理を中断します。"
Exit Sub

End If

On Error Resume Next

fdname = Cells(6, 5)

l_end = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

'削除区分の確認とファイル
For i = 9 To l_end

  If Cells(i, 6) <> "" Then
    bok = Cells(i, 5)
    Kill fdname & bok '削除の実行
    If Err.Number = 53 Then
      MsgBox (fdname & bok & "存在しない。  ErrorCode:" & Err.Number)
      Err.Clear
    Else: b = b + 1
    End If
  End If

Next i

MsgBox ("終了しました。 ■削除したファイル数:" & b)

End Sub


 お試し版ダウンロード 

○Download file: excv110.lhz