(VBA) 同名フォルダーの存在をチェック
以下のコード(Sub ⑤フォルダー名の変更())でフォルダー名の変更を行っています。
変名時に同名ファイルがある場合エラーが以下のコードでエラーがでます。
.GetFolder(Range("A2").Text & Range("B" & i).Text).Name = Cells(i, LastColumn).Text
エラー無く処理したいので
同名があるばあいは、フォルダー名の末尾に(1)、(2)を付加したいのですが
同名があるかどうかは?どのように判定しますか ?
Sub ⑤フォルダー名の変更()
Dim i As Long
Dim LastColumn As Single
Dim LastColumn_ABC As String
Dim MSG As String
LastColumn = Cells(5, "B").End(xlToRight).Column
LastColumn_ABC = Split(Cells(1, LastColumn).Address, "$")(1)
MSG = MsgBox("B列フォルダー名が" & LastColumn_ABC & "列フォルダー名に変更されます!" & vbCrLf _
& "B," & LastColumn_ABC & "列に値がなければ、処理は行いません。", 257, "フォルダー名変更")
If MSG = vbCancel Then Exit Sub
i = 5 'subフォルダ名取得が5行目からフォルダー名を表示するため。
Do While Range("b" & i).Text <> ""
If Cells(i, LastColumn).Text <> "" Then ' 新フォルダー名がある場合のみ、名前変更を行う。
With CreateObject("Scripting.FileSystemObject")
.GetFolder(Range("A2").Text & Range("B" & i).Text).Name = Cells(i, LastColumn).Text
End With
End If
i = i + 1
Loop
MsgBox "変名処理が終了しました。"
End Sub
お礼
解決できました。 どうもありがとうございます。