特殊なファイル削除のコードを書いていたら、より複雑な条件分岐になってしまい、Select Caseステートメントの入れ子構造で処理 ー 重複ファイル削除（VBA）

何度もダウンロード

　　　　

パソコンを使っていて、PDF等の資料をダウンロードすることがよくあります。

そんな時、誤って二度三度とクリックして、同じ資料を複数ロードしてしまう。

エクスプローラからダウンロードフォルダーを見れば、ファイル+連番の名前。

つまり、”HogeHoge.pdf”、”HogeHoge (1).pdf”、”HogeHoge (1).pdf”,,,,

こんな風になると思いますが、こういった括弧書きファイルは無用で消したい。

でも、仕事上、ダウンロードは必要だから、ほったらかしにするのが普通です。

無駄なファイルが溜まるのは分かっているけれど、ドライブの圧迫もないんだ。

そのまま、何百何千になっても平気なのは、最近のドライブ容量が大きいから。

ですが、不要なら削除すべきと考え直して、VBAプログラムを組んでみました。

実は、エクセルにマクロを組んでいて、zipファイルのダウンロードが必要です。

動作としては、ファイル解凍でファイルを取り出して同じフォルダに置きます。

この作業を行う際、念のため、ダブって存在するファイルは削除しておきたい。

一方、このダウンロードは、別にSAPのビジネスオブジェクトから作業します。

MRPシステムに連携して、必要なデータを検索抽出してCSVファイルを保存だ。

でも、ダウンロードでフォルダー内に既にファイルが存在するかは確認しない。

なので、業務に使うマクロでは、既にファイルが存在していたら削除を実行だ。

しかも、”(1)”のようなファイルが複数存在していたら、これも同時に削除です。

ファイル名だけなら削除は簡単でも、”(1)”みたいファイルを特定するのが困難。

というわけで、色々と試行錯誤した結果、この手のファイルを削除できました。

このサンプルコードを参考までに掲げておきますので、参考いただくとして、カッコの中が数値であるのを、IsNumeric関数で認識させたり、SelectCaseの条件分岐式で四重に入れ子を深めたりしたのは、かなり複雑だなと思ったのでした。

＜サンプルコード＞

Sub FileDelete()

Dim FSO As Object, Fldr As Object, Fle As Object, Trgt As String

Dim Str As Variant, NmeLst As Variant, rc As VbMsgBoxResult

  Set FSO = CreateObject("Scripting.FileSystemObject")

   Trgt = "" '変数FSOでファイルシステムオブジェクト立ち上げ

    Trgt = Trgt & "C:\Users\"

     Trgt = Trgt & Environ("USERNAME")

      Trgt = Trgt & "\Downloads\"

  Set Fldr = FSO.GetFolder(Trgt) '変数FSOから特定フォルダ取得

For Each Fle In Fldr.Files

 Str = Split(Fle.Name, ".") '拡張子を除いたファイル名をStr(0)で取得

  Select Case Len(Str(0)) '①条件設定が多層で入れ子４度回し

   Case Is > 3 'ファイル名が四文字以上（*(*)）ある条件

    Select Case Mid(Str(0), Len(Str(0)) - 2, 1) '②度目の入れ子

     Case "(" 'ファイル名に後ろから３文字目に"(”が存在

      Select Case Mid(Str(0), Len(Str(0)), 1) '③度目の入れ子

       Case ")" 'ファイル名に後ろから１文字目に")”が存在

        Select Case IsNumeric(Mid(Str(0), Len(Str(0)) - 1, 1)) '④度目入れ子

         Case True 'ファイル名に後ろから２文字目が数値が真

           rc = MsgBox(Fle.Name & vbCrLf & _

             "ファイルを削除しますか？", vbYesNo + vbQuestion)

             If rc = vbYes Then

               Kill (Trgt & Fle.Name) 'ファイル名の削除

               End If

        End Select '④度目入れ子終了

      End Select '③度目の入れ子終了

    End Select '②度目の入れ子終了

  End Select '①度目入れ子終了

Next Fle

  Set FSO = Nothing

  Set Fldr = Nothing

End Sub

注：エクスプローラから、"* (?).*" と打つと検索は出来るようです。

いいねと思ったら、三つポチっとね！
  
にほんブログ村    にほんブログ村      にほんブログ村