[[20231214144606]]　『Dirコマンドを使用しファイル一覧を取得したいのａx（メルシー）　ページの最後に飛ぶ

『Dirコマンドを使用しファイル一覧を取得したいのですが、除外したいファイルがあります』（メルシー）

いつもお世話になっております。
業務でマクロを使用しているのですが、
フォルダ内にあるExcelファイルを取得し、リスト化するというマクロを
組もうとしています。

https://www.moug.net/tech/exvba/0060087.html
ネットで探して試し、一番処理が早かったこちらの参考コードを使用させていただき、自環境に合わせて組んでいるのですが、

フォルダ内にはサブフォルダ内のファイル含み5000以上のエクセルファイルがあるため、命令を追加して必要なファイルだけ抜き出したいと考えています。

この下記のコードにif文を組み込めれば…と思ったのですが、自分の知識が浅く、組み込めそうなところがなさそうでご指南いただきたく質問しました。

　・特定の文字列を含むフォルダやファイルを除外
したい場合、どこを操作すればいいでしょうか？

無知で申し訳ありませんがよろしくお願いします。

Sub 読み込み()

    Const SEARCH_DIR As String = "フォルダのパス"  'フォルダ名の末尾の"\"は不要
    Const SEARCH_FILE As String = "*.xls*"
    Dim tmpFile As String
    Dim strCmd As String
    Dim buf() As Byte
    Dim Filelist() As String
    Dim myArray() As String
    Dim cnt As Long, pt As Long, i As Long
    Dim iRow As Long

    '処理実行時の画面描画をオフにして処理を高速化
    Application.ScreenUpdating = False

    'Dirコマンドの結果を出力する一時ファイル
    tmpFile = Environ("TEMP") & "\Dir.tmp"

    'Dirコマンド用の文字列を編集

    strCmd = "Dir """ & SEARCH_DIR & "\" & SEARCH_FILE & _
              """ /b/s/a:-d > """ & tmpFile & """"

        'WSHでDirコマンドを実行 ---------------(1)
    With CreateObject("Wscript.Shell")

        .Run "cmd /c" & strCmd, 7, True

    End With

    '該当ファイルの存在チェック
    If FileLen(tmpFile) < 1 Then
        MsgBox "該当するファイルがありません"
        Exit Sub
    End If

    'Dirコマンドの結果を出力した一時ファイルを読み込み
    Open tmpFile For Binary As #1
        ReDim buf(1 To LOF(1))
        Get #1, , buf
    Close #1
    Kill tmpFile

    Filelist() = Split(StrConv(buf, vbUnicode), vbCrLf)

    'Dirコマンドの出力件数
    cnt = UBound(Filelist)

    'ワークシート書き出し用の配列 ---------(2)
    ReDim myArray(1 To cnt, 1 To 2)
    For i = 1 To cnt

        pt = InStrRev(Filelist(i - 1), "\")
        myArray(i, 1) = Left(Filelist(i - 1), pt)    'パス
        myArray(i, 2) = Mid(Filelist(i - 1), pt + 1) 'ファイル名
    Next i

   '配列の値をワークシートに出力

    lRow = Cells(Rows.Count, "A").End(xlUp).Row + 1

    Cells(lRow, 1).Resize(cnt, 1).Value = WorksheetFunction.Transpose(Filelist)

    '処理実行時の画面描画をオフにして処理を高速化
    Application.ScreenUpdating = True

End Sub

＜使用 Excel：Microsoft365、使用 OS：Windows11 ＞

 取得したファイルパスのリストは、
 配列変数Filelist内にあると思いますので、
 Filelistに対してFilter関数を使って含むや除外の処理をしてはどうでしょうか。

 例）AAAフォルダを除外する
 Filelist = Filter(Filelist, "\AAA\", False)
（通りすがり助六） 2023/12/14(木) 15:06:45

通りすがり助六様

仰るとおりにfilter関数を追加したら除外できるようになりました、
ありがとうございます！助かりました！
（メルシー） 2023/12/14(木) 17:05:01

 解決された用ですが、メモとして。

 Sub sample()
   Dim path As String, filename As Variant
   path = "D:\test\*.xls*"
   For Each filename In EnumFiles("D:\test\*.xls*", " -Exclude *除外*")
       Debug.Print filename
   Next
 End Sub

 Function EnumFiles(path As String, Optional ByVal OptionStr As String = "") As String()
   Dim cmd As String
   cmd = "Get-ChildItem -File -Path " & path & " " & OptionStr & " |ForEach-Object { $_.FullName }"
   With CreateObject("WScript.Shell")
       buf = .Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & cmd).StdOut.ReadAll
   End With
   EnumFiles = Split(buf, vbCrLf)
 End Function
（´・ω・`） 2023/12/14(木) 17:12:52

 メモとして（その２）

 ↓のクリップボード経由というのに興味をひかれて、まねっこ
　https://www.shegolab.jp/entry/vba-find-file

 Sub test()
    Dim fdg As FileDialog
    Dim p As String
    Dim exc As String
    Dim cmd As String

    Set fdg = Application.FileDialog(msoFileDialogFolderPicker)
    If Not fdg.Show Then Exit Sub

    p = fdg.SelectedItems(1) & "\*.xls?"
    exc = "*除外文字*"    '除外しない場合は、""で

    ' ファイル検索結果を、タブ区切りでクリップボードにコピー
    cmd = "ls '" & p & "' -r -af|" _
        & "?{$_.fullname -notlike '" & exc & "'}|" _
        & "%{($_.directory.name, $_.name) -join [char]0x9}|scb"

    CreateObject("wscript.shell") _
        .Run "powershell -ExecutionPolicy RemoteSigned -Command " & cmd, 0, True

    If Application.ClipboardFormats(1) = -1 Then
        MsgBox "ファイルは見つかりませんでした"
        Exit Sub
    End If

    With Worksheets.Add
        .Range("A1:B1").Value = Array("folder", "file")
        .Paste .Range("A2")
        .UsedRange.Columns.AutoFit
    End With

 End Sub

 除外したいフォルダ配下にフォルダがあった場合は、それも除外対象でよい？
（マナ） 2023/12/17(日) 23:06:43

コメント返信：

[ 一覧(最新更新順) ]

[[20231214144606]] 『Dirコマンドを使用しファイル一覧を取得したいのａx（メルシー） ページの最後に飛ぶ

[[20231214144606]]　『Dirコマンドを使用しファイル一覧を取得したいのａx（メルシー）　ページの最後に飛ぶ