#深夜の俺の戯言

昼間の戯言でも深夜テンション。

【VBA】異なるパスのそれぞれの配下にフォルダを一括作成【マクロ】

仕事で300程度のディレクトリを作成する必要があった.

 

上位までのパスと作成したいフォルダ名は分かっており,それらをエクセルで管理していたため,4年ぶりにマクロを組んでみることになった.

実際は社内の先輩にかかりっきりで助けてもらったのだが,どこかの誰かの助けになると信じて覚え書き.

 

以下のサイトを参考にした.

https://moripro.net/vba-mkdir-folder/

このサイトでは下図のシートを作成し,'C:\フォルダ一括作成'配下にフォルダを作るというものであった.ソースコードはそちらを参照して頂ければと思う.

f:id:comet-heart-1:20190814093702p:plain

上記サイトより転載

 

ただ,今回私がやりたかったことは,異なる上位パスのそれぞれの配下にフォルダを作成することであった.そこで下図のようなシートを作成した.

f:id:comet-heart-1:20190814094530p:plain

こんな階層構造を作りたい

で,いろいろ助けてもらって(ほとんど先輩が)書いたソースコードがこちら

 

Sub mkdirFolder()


Dim Path As String
For i = 2 To Range("B2").End(xlDown).Row

Dim FolderName As String '作成するフォルダ名
Path = Cells(i, 1).Value
Cells(i, 2).Select

Call ReplaceHyphen '文字化けする全角ハイフンをやっつける

FolderName = Cells(i, 2).Value

Dim NewDirPath As String '作成するフォルダの上位パス
NewDirPath = Path & "\" & FolderName & "\"

'フォルダ名被りチェック
If Dir(NewDirPath, vbDirectory) = "" Then
mkdir NewDirPath
End If

Next i

MsgBox "終わってるはず"

End Sub

 

Sub ReplaceHyphen()
Selection.Replace What:=ChrW(8722), Replacement:="-" '文字化けするやつ
Selection.Replace What:=ChrW(8208), Replacement:="-" '全角ハイフン
End Sub

 

これで上手く回った.

 

捕捉として ReplaceHyphen() について.

マクロの環境(下図)では全角ハイフン"-"がサポートされていないようで,半角ハテナ"?"に勝手に置換されてしまっていた.

そこで文字コードを無理やりいじって全角ハイフンを半角ハイフンに置換するようなコードを先輩に書いてもらった.

f:id:comet-heart-1:20190814095502p:plain

マクロ開発環境

まあ,作成したいフォルダ名に最初から全角ハイフン入力しなければいいだけの話なんだけど.

 

地道に勉強していこうと思います.