none
Scripting.dictionaryのExistsメソッドのあいまい検索(中間一致)について RRS feed

  • 質問

  • VBSで2種類のScripting.Dictionaryを作成してファイルと空きフォルダ削除をするプログラムを作成しています。

    1つの辞書は除外フォルダ名(A)---例:"My Documents"

    もう1つは除外拡張子(B)---例:"pdf"

    等が格納(AもBも数は不定)されています。

    削除フォルダをユーザーが指定し---例"C:\Work\"

    配下フォルダ内の各ファイルのフルパスを取得し、A辞書と部分一致しなかったファイル(例ではMy Documentsがフルパスに含まれるファイル以外)、かつBと完全一致しなかったファイル(例ではpdfファイル以外)を削除するイメージです。

    Bと完全一致しないファイルについてはうまく除外して削除することができました。

    しかし、フォルダ名はフルパスの中の一部なのでdic.Exists(指定フォルダ名)としても全てFALSEが返されます。

    このような場合どのように対処すれば良いのでしょうか。ヒント、アドバイスよろしくお願いいたします。

    2017年10月18日 2:40

回答

  • Existsでは部分一致は使えません。
    Dictionaryから中身を取り出して、Instrなどで文字列を調べましょう

    Dim shell
    Set shell = CreateObject("WScript.Shell")
    Dim targetFolder
    targetFolder = shell.ExpandEnvironmentStrings("%USERPROFILE%\Desktop")
    
    Dim FSO 'As IWshRuntimeLibrary.FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim aryExcludeFolders()
    ReDim aryExcludeFolders(0)
    aryExcludeFolders(0) = "Desktop"
    MsgBox aryExcludeFolders(0)
    
    Dim arySkippedFolder
    arySkippedFolder = Split(aryExcludeFolders(0), ";")
    
    Dim dicExcludeFolders '除外フォルダ一覧を格納する辞書
    Set dicExcludeFolders = CreateObject("Scripting.Dictionary")
    
    Dim index
    Dim count
    For index = LBound(arySkippedFolder) To UBound(arySkippedFolder)
        ext = "\" & aryExcludeFolders(index) & "\"
        dicExcludeFolders.Add ext, ext
    Next
    
    Dim fol
    Dim f 'As IWshRuntimeLibrary.File
    Set fol = FSO.GetFolder(targetFolder)
    
    For Each f In fol.Files
        
        ext = FSO.GetExtensionName(f)
        
        Dim excludeFolderName
        For Each excludeFolderName In dicExcludeFolders
            If (InStr(f.path, excludeFolderName) > 0) Then
                MsgBox "「" & f.path & "」は「" & excludeFolderName & "を含んでいます"
            Else
                MsgBox "「" & f.path & "」は「" & excludeFolderName & "を含んでいません"
            End If
        Next
    
    Next

    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    • 回答としてマーク yuppie0828 2017年10月23日 8:45
    2017年10月18日 3:59

すべての返信

  • PowerShellとの関連がわかりません。無関係なのであれば適切なフォーラムを選択する努力をしてください。
    2017年10月18日 3:16
  • Existsでは部分一致は使えません。
    Dictionaryから中身を取り出して、Instrなどで文字列を調べましょう

    Dim shell
    Set shell = CreateObject("WScript.Shell")
    Dim targetFolder
    targetFolder = shell.ExpandEnvironmentStrings("%USERPROFILE%\Desktop")
    
    Dim FSO 'As IWshRuntimeLibrary.FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim aryExcludeFolders()
    ReDim aryExcludeFolders(0)
    aryExcludeFolders(0) = "Desktop"
    MsgBox aryExcludeFolders(0)
    
    Dim arySkippedFolder
    arySkippedFolder = Split(aryExcludeFolders(0), ";")
    
    Dim dicExcludeFolders '除外フォルダ一覧を格納する辞書
    Set dicExcludeFolders = CreateObject("Scripting.Dictionary")
    
    Dim index
    Dim count
    For index = LBound(arySkippedFolder) To UBound(arySkippedFolder)
        ext = "\" & aryExcludeFolders(index) & "\"
        dicExcludeFolders.Add ext, ext
    Next
    
    Dim fol
    Dim f 'As IWshRuntimeLibrary.File
    Set fol = FSO.GetFolder(targetFolder)
    
    For Each f In fol.Files
        
        ext = FSO.GetExtensionName(f)
        
        Dim excludeFolderName
        For Each excludeFolderName In dicExcludeFolders
            If (InStr(f.path, excludeFolderName) > 0) Then
                MsgBox "「" & f.path & "」は「" & excludeFolderName & "を含んでいます"
            Else
                MsgBox "「" & f.path & "」は「" & excludeFolderName & "を含んでいません"
            End If
        Next
    
    Next

    個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

    • 回答としてマーク yuppie0828 2017年10月23日 8:45
    2017年10月18日 3:59
  • アドバイスありがとうございます。

    VBSはフォーラムを持たないのでPowerShellフォーラムで質問いたしました。

    次回よりクライアントOSのフォーラムとします。

    2017年10月18日 5:42
  • 確認遅くなりました。申し訳ありません。

    無事動作いたしました。フォルダ属性をチェックしながら削除するようにしました

    (\Documents\My Music.lnk等は削除できずエラーが発生するため)。

    どうもありがとうございました。

    2017年10月23日 8:45