ファイル名の右側を変更したい ファイル名：「1001日別売上」の左側へ「2022」を追加し、「202

ファイル名の右側を変更したい
ファイル名：「1001日別売上」の左側へ「2022」を追加し、「20221001日別売上」へ変更するのに下記コードを使っています。今回の質問としてファイル名：「20221001日別売上」の右側へ「_確認済」を追加し、「20221001日別売上_確認済」としたいのですが右側を変更するためのコード変更部分が解りません。よろしくお願いいたします。
Sub A2_指定文字追加()
Dim FileP As String
'フォルダ選択のダイアログボックスを開く
Application.FileDialog(msoFileDialogFolderPicker).Show
'選択したフォルダのパス名を取得
FileP = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
MsgBox "追加文字をコピーしてください"
'ファイル名の変換
Dim FileA As String
'選んだフォルダの拡張子xlsを含むファイルを返す
FileA = Dir(FileP & "\*.xls*")
'ファイル名の変換
Dim Str1 As String, Str2 As String
'変換前の対象文字列
Str1 = InputBox("追加文字を貼り付けてください", "ファイル名変更", "") '←任意で変える部分
'変換後の文字列
Str2 = "" '←任意で変える部分
'フォルダ内のファイルがなくなるまで繰り返す
Do While FileA <> ""
'各ファイルのStr1部分をStr2に変換する
Name (FileP & "\" & FileA) As (FileP & "\" & Str1 & FileA)
'Dirの指定をなくす
FileA = Dir()
Loop
End Sub

質問者からの補足コメント

• コードのご提示ありがとうございます。
  補足になりますが「＿確認済」は固定ではなくポップアップ画面で指定して変更できるようなことができませんでしょうか。よろしくお願いします。

    補足日時：2022/10/14 11:55

No.5 ベストアンサー 回答者： tatsumaru77 回答日時： 2022/10/14 13:38

No3です。

>補足になりますが「＿確認済」は固定ではなくポップアップ画面で指定して変更できるようなことができませんでしょうか。

Sub A2_指定文字追加()を以下のように変えてください。
Public Function add_str　は変えません。
str2を使用するようにしました。


Sub A2_指定文字追加()
Dim FileP As String
'フォルダ選択のダイアログボックスを開く
Application.FileDialog(msoFileDialogFolderPicker).Show
'選択したフォルダのパス名を取得
FileP = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
MsgBox "追加文字をコピーしてください"
'ファイル名の変換
Dim FileA As String
'選んだフォルダの拡張子xlsを含むファイルを返す
FileA = Dir(FileP & "\*.xls*")
'ファイル名の変換
Dim Str1 As String, Str2 As String
'変換前の対象文字列
Str1 = InputBox("追加文字を貼り付けてください", "ファイル名変更", "") '←任意で変える部分
'変換後の文字列
Str2 = InputBox("右側の追加文字を貼り付けてください", "ファイル名右側変更", "") '←任意で変える部分
'フォルダ内のファイルがなくなるまで繰り返す
Do While FileA <> ""
'各ファイルのStr1部分をStr2に変換する
Dim newname As String
'FileAに_確認済を付加する
newname = add_str(FileA, Str2)
Name (FileP & "\" & FileA) As (FileP & "\" & Str1 & newname)
'Dirの指定をなくす
FileA = Dir()
Loop
End Sub

この回答へのお礼

ありがとうございました。毎月手作業で200件のリネーム作業をしなくて済みます。助かりました。

お礼日時：2022/10/14 15:23

No.6 回答者： めぐみん_ 回答日時： 2022/10/14 15:03

別回答の方では対策が取られていたらダブって申し訳ないです。

【VBA】InputBox関数でキャンセルされた時の判定方法
https://yaromai.jp/inputbox_cancel/

InputBoxで必ず入力を行なうのであれば関係ないですが、もし違う場合に参考になりそうなサイトをあげておきます。

No.4 回答者： めぐみん_ 回答日時： 2022/10/14 13:06

No.1*2です。

他の回答は見られないので補足のコードはわかりませんが、

＞ポップアップ画面で指定して変更できるようなことができませんでしょうか。

変数：str1と同じようにstr2を作ってみるとかではないかな。
ベテラン回答者様には及ばないアドバイスで申し訳ないです。
Excelなしでテキストエディタだけで作成できる程のスキルがないもので。

No.3 回答者： tatsumaru77 回答日時： 2022/10/14 11:22

以下のようにしてください。

Nameを実行する前にadd_strを呼び出し、FileAに_確認済を付加した名前を取得します。取得した名前をNameで変更します。


Sub A2_指定文字追加()
Dim FileP As String
'フォルダ選択のダイアログボックスを開く
Application.FileDialog(msoFileDialogFolderPicker).Show
'選択したフォルダのパス名を取得
FileP = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
MsgBox "追加文字をコピーしてください"
'ファイル名の変換
Dim FileA As String
'選んだフォルダの拡張子xlsを含むファイルを返す
FileA = Dir(FileP & "\*.xls*")
'ファイル名の変換
Dim Str1 As String, Str2 As String
'変換前の対象文字列
Str1 = InputBox("追加文字を貼り付けてください", "ファイル名変更", "") '←任意で変える部分
'変換後の文字列
Str2 = "" '←任意で変える部分
'フォルダ内のファイルがなくなるまで繰り返す
Do While FileA <> ""
'各ファイルのStr1部分をStr2に変換する
Dim newname As String
'FileAに_確認済を付加する
newname = add_str(FileA, "_確認済")
Name (FileP & "\" & FileA) As (FileP & "\" & Str1 & newname)
'Dirの指定をなくす
FileA = Dir()
Loop
End Sub


Public Function add_str(ByVal fname As String, ByVal astr As String) As String
Dim pos As Variant
Dim xlen As Long
add_str = fname
pos = InStrRev(fname, ".")
If pos < 1 Then Exit Function
xlen = Len(fname) - pos + 1
add_str = Mid(fname, 1, pos - 1) & astr & Right(fname, xlen)
End Function

No.2 回答者： めぐみん_ 回答日時： 2022/10/14 10:28

No.1です。

拡張子の存在忘れてましたのでスル～して下さい。

No.1 回答者： めぐみん_ 回答日時： 2022/10/14 10:25

よくわかりませんが既に変更済みなら

Name (FileP & "\" & FileA) As (FileP & "\" FileA & "_確認済")

とか？