Excelのマクロについて教えてください。 下記のマクロは以前教えて頂いたマクロです。 マクロを実行するとフォルダ内のPDFファイル名にセルB2の検索文字がが含まれている場合に その作業フォルダ名にセル「B2」+(あり)のフォルダ名に変更出来るようになっております。 例えば 検索文字B2に「軽微」がある場合に フォルダ名「北海 太郎」が「北海太郎(軽微あり)」となります。 しかし、 このマクロを実行するたびに検索文字があり場合にフォルダ名に検索文字が追加されてしまします。 例えば 「北海 太郎」が「北海太郎(軽微あり)」「北海太郎(軽微あり)(軽微あり)」 「北海太郎(軽微あり)(軽微あり)(軽微あり)」等々です。 下記のマクロを変更して マクロを実行した場合に一度だけフォルダ名が変更に出来る方法を教えてください。 宜しくお願い致します。 Sub 軽微() Dim alert As VbMsgBoxResult alert = MsgBox("軽微確認してよろしいですか?", vbYesNo + vbQuestion, "軽微確認") If alert <> vbYes Then Exit Sub End If Dim PathM As String Dim SearchWord As String, AddWord As String '---検索ワードの取得と追加ワードの作製 SearchWord = Range("B2") AddWord = "(" & SearchWord & "あり)" '---親フォルダ(ブックのフォルダ)取得 PathM = ThisWorkbook.Path & "\" Call サブフォルダ取得(PathM, SearchWord, AddWord) End Sub Sub サブフォルダ取得(target_folder As String, search_word As String, add_word As String) '---ファイルシステムオブジェクトを設定 Dim FSO As Object, SubFol As Object, F As Object Set FSO = CreateObject("Scripting.FileSystemObject") '---親フォルダ内の各サブフォルダ For Each SubFol In FSO.getfolder(target_folder).subfolders '---サブフォルダ内の各ファイル For Each F In SubFol.Files '---PDFファイルなら If InStr(F.Name, ".pdf") <> 0 Then '---検索ワードを含むなら If InStr(F.Name, search_word) <> 0 Then '---サブフォルダ名に検索ワードを追加 SubFol.Name = SubFol.Name & add_word Exit For End If End If Next Call サブフォルダ取得(target_folder & SubFol.Name & "\", search_word, add_word) Next End Sub 以上となります。 宜しくお願い致します。
Visual Basic