【VBA】フォルダ配下の指定した拡張子を持つ全てのファイルに対し、コマンドを実行する

PR

前提

・ここではテキストファイル(.txt)のみを対象とする。必要に応じて修正する
・ここではcopyコマンドを実行する。必要に応じて修正する
・INPUTフォルダはセル「B3」に、OUPUTフォルダはセル「B6」に入力する
・上記セルに以下の入力チェックを行う
 ┗入力必須チェック
 ┗フォルダパス存在チェック

PR

準備

・ INPUTフォルダはセル「B3」に、OUPUTフォルダはセル「B6」に入力 する旨を記載する
・実行ボタンを配置する

PR

サンプルプログラム

下記のプログラムを記載し、実行ボタンにマクロとして設定する

'変数の宣言を必須
Option Explicit

Sub folderSelectDialogSample()
    
    Const TARGET_FILE_TYPE As String = "txt"
    Dim pathCheck As String
    Dim inputFolderPath As String
    Dim outputFolderPath As String
    Dim command As String
    Dim wsh As Object
    Dim fso As Object
    Dim f As Object
    
    'INPUTフォルダの入力必須チェック
    If Range("B3").Value = "" Then
        MsgBox "INPUTフォルダが入力されていません"
        Exit Sub
    End If

    'OUTPUTフォルダの入力必須チェック
    If Range("B6").Value = "" Then
        MsgBox "OUTPUTフォルダが入力されていません"
        Exit Sub
    End If

    'INPUTフォルダの存在チェック
    pathCheck = Dir(Range("B3").Value, vbDirectory)
    If pathCheck = "" Then
        MsgBox "INPUTフォルダが存在しません"
        Exit Sub
    End If

    'OUTPUTフォルダの存在チェック
    pathCheck = Dir(Range("B6").Value, vbDirectory)
    If pathCheck = "" Then
        MsgBox "OUTPUTフォルダが存在しません"
        Exit Sub
    End If
    
    inputFolderPath = Range("B3").Value
    outputFolderPath = Range("B6").Value
    
    Set wsh = CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    For Each f In fso.GetFolder(inputFolderPath).Files
        If LCase(fso.GetExtensionName(f.Name)) = TARGET_FILE_TYPE Then
            
            'コマンドの組み立てと実行
            command = "copy /b " & f.Path & " " & outputFolderPath & "\" & f.Name
            wsh.Run "%ComSpec% /c " & command, vbHide, True
            
        End If
    Next
    '後片付け
    Set wsh = Nothing
    Set fso = Nothing
End Sub
タイトルとURLをコピーしました