同一階層に存在する複数のフォルダに対して、同じ内容の新規の空フォルダを一括で作成したい

Question

実現したいこと

同一階層に存在する複数のフォルダに対して、同じ内容の新規の空フォルダを一括で作成したいです。
例えば、下記のように都道府県フォルダが同一階層に格納されています。

都道府県風景画像フォルダ > 千葉県
都道府県風景画像フォルダ > 神奈川県
都道府県風景画像フォルダ > 東京都
都道府県風景画像フォルダ > 群馬県

それぞれにjpgフォルダを格納し整理します。
余分になる画像を新規フォルダに作成して格納する必要があります。

都道府県風景画像フォルダ > VBSをクリックする
都道府県風景画像フォルダ > 千葉県 > 余分画像
都道府県風景画像フォルダ > 神奈川県 > 余分画像
都道府県風景画像フォルダ > 東京都 > 余分画像
都道府県風景画像フォルダ > 群馬県 > 余分画像

「余分画像」というフォルダを一括で作成する方法を探しております。
方法はなんでも構いません。

要点等

• フォルダの直下にVBSをおいて一括で追加したいです
• 同階層のフォルダに対して任意の文字列のフォルダを新規追加したいです

お手数おかけしますが教えていただけますと幸いです。
よろしくお願い致します。

Answer 1

Dim tFso
Dim tFolder
Dim tFolderSub
Set tFso = CreateObject("Scripting.FileSystemObject")
Set tFolder = tFso.GetFolder(tFso.GetParentFolderName(WScript.ScriptFullName))

Dim tFolderName
tFolderName=InputBox("作成するフォルダ名を指定してください。")

For Each tFolderSub In tFolder.SubFolders
    tFso.CreateFolder tFso.BuildPath(tFolderSub.Path, tFolderName)
Next

Msgbox "作成完了"

こんな感じですか？

Comments

[NAOT1192]

まさに、こちらの意図するもの以上の内容でした。
文字列を自由に指定できるところが素晴らしいです。
ありがとうございました。