EXCELのVBA(マクロ)でファイル名をリネームする

Question

###前提・実現したいこと

EXCELのVBAでファイル名をリネームしてリネームされたファイルのみを残したいです。
現在使っているマクロはネットで探し出したものですが、若干使いにくいのでご指南ください。

【現在使っているマクロ】
・A2セルに該当のフォルダパスを手入力する
・A3セルにリネーム後の出力先フォルダパスを手入力する
・一つ目のマクロでA2のフォルダからファイル名を取得してA7から下方向に一覧表示させる処理があります。
・B7から下方向へは新しいファイル名を一覧表示している(これは関数を利用して私が作ったファイル名を入力します)
・2つ目のマクロでA7～に表示されたファイル名からB7～に記載したファイル名にリネームし、A3のフォルダへ出力する

【困っていること/やりたいこと】
・上記の方法だとA2のフォルダとA3のフォルダに分かれて新・旧で同じ内容のファイル郡ができてしまう。
・フォルダは一つにまとめたい。
・出力先をA2に記載したフォルダにまとめても同じフォルダ内に新・旧で同じ内容のファイル郡ができるので、(A7～に一覧表示された)旧ファイル名のファイルのみ消すか、あるいは完全にファイル名のみを変更したい。
・ファイルのリネームが完了したらMsgboxで「リネームが完了しました」あるいは「旧ファイルを削除しました」「OK」を最後に表示したい。

###発生している問題・エラーメッセージ

上記をご参照ください。

###該当のソースコード

Sub ファイル一覧作成()

Dim FileName As String
Dim i As Long

If Range("B2").Value = "" Then
    MsgBox "コピー元フォルダ名を入力してください"
    Exit Sub
End If

i = 7

FileName = Dir(Range("B2").Value & "*.JPG")
Do Until FileName = ""
    Cells(i, 1).Value = FileName
    FileName = Dir()
    i = i + 1
Loop

MsgBox "ファイル名一覧を作成しました"

End Sub

Sub ファイル名変更()

Dim i As Long

If Range("B3").Value = "" Then
    MsgBox "コピー先フォルダパスを入力してください"
    Exit Sub
End If

i = 7

Do Until Cells(i, 1).Value = ""
    If Cells(i, 2).Value = "" Then
        Cells(i, 3).Value = "ファイル名未入力"
    Else
        FileCopy Range("B2").Value & "\" & Cells(i, 1).Value, Range("B3").Value & "\" & Cells(i, 2).Value
    End If
    i = i + 1
Loop

MsgBox "リネーム処理が終了しました"

End Sub

###試したこと

旧ファイルがデジカメで撮影した写真なので旧ファイル名が「DSC01234.JPG」のようなものなので、Killステートメントで削除対象を「DSC*」にしているのですが、場合によっては別のファイル(スマホから取り込んだ画像ファイル)などもありえます。

###補足情報(言語/FW/ツール等のバージョンなど)

EXCEL2016
VBA

Answer 1

元フォルダからファイルを消したいのであれば、FileCopyの後に

Kill Range("B2").Value & "\" & Cells(i, 1).Value

を追加

1つでもファイルのリネームが行われていたら「リネーム処理が終了しました」と表示したいのであれば、

Dim i As Longの後に

Dim isRenamed As Boolean
isRenamed = False

を追加、FileCopyの後（またはKillの後）に

isRenamed = True

を追加、最後のMsgBoxは

If (isRenamed) Then
    MsgBox "リネーム処理が終了しました"
Else
    MsgBox "（空振り時のメッセージ）"
End If

とでも置き換えてやればいいかと思います。

Comments

[sakura_yo]

やりたい処理ができるようになりました。
ありがとうございました！

Answer 2

ファイルをリネームしたいってことでしょうか？
だとしたら
FileCopy Range("B2").Value & "" & Cells(i, 1).Value, Range("B3").Value & "" & Cells(i, 2).Value
を
Name Range("B2").Value & "" & Cells(i, 1).Value As Range("B2").Value & "" & Cells(i, 2).Value
に修正すればリネームができます。

Comments

[sakura_yo]

質問にもあるようにリネーム自体はできています。