VBA シート名とファイル名とフォルダ名を一度に変更したい

質問

こんばんは。
現在のアクティブセルに入力された文字列「(例）0001」を入力するとシート名、ファイル名、フォルダ名が変更するVBAを作成しています。
シート名の変更は出来たのですが、ファイル名とフォルダ名の変更が上手くいきません。
大変恐れ入りますが、伝授いただけないでしょうか。
よろしくお願い致します。

Sub シート名変更()
Dim シート名 As String
シート名 = ActiveCell.Value
If シート名 = "" Then
MsgBox "文字列を含むセルを選択してください。"
Exit Sub
End If
ActiveSheet.Name = シート名
End Sub

回答No.1

watabe007 · ベストアンサー

>ファイル名とフォルダ名の変更が上手くいきません。
フォルダ名を変更するのではなく保存先とファイル名を変えるのですね？

Sub Test()
　　Dim 元ファイル名 As String
　　With ThisWorkbook
　　　　元ファイル名 = .FullName
　　　　Application.DisplayAlerts = False
　　　　.SaveAs Filename:="J:\さんぷる.xls"　　　　'指定フォルダー、指定のファイル名で保存
　　　　Application.DisplayAlerts = True
　　　　Kill str　　　　　　　　　　　　　　　　　　　'元ファイルを削除
　　　　.Close False　　　　　　　　　　　　　　　　　'ファイルを閉じる
　　End With
End Sub

補足

>フォルダ名を変更するのではなく保存先とファイル名を変えるのですね？

早速の回答をありがとうございます。
フォルダ名も変更したいと思っています。
毎日同じ作業を行っており、フォルダがメールにて送られてきて、一つのフォルダには一つのファイルしかなく、シートはシート１、２、３と三枚あります。
添付されたフォルダをディスクトップに保存し、シート１のＡ１に入力された文字列「(例）0001」を入力すると、シート１のシート名とファイル名と、フォルダ名がＡ１に入力された文字列「(例）0001」に自動的に変更になるように、ＶＢＡを組みたいと思っています。

よろしくお願い致します。