スキルアップ・問題解決なら、モーグにおまかせ！

フォルダとサブフォルダに５００個くらいエクセルファイルが保存されていますが、このファイル名を
リネームするマクロを教えてください。
何卒、宜しくお願いします。

【修正再掲失礼しました】
https://www.tipsfound.com/vba/18011
  
具体的な変換パターンはどのようなものですか。
例えば、
xxxx.xls => xxxx_1.xls
yyyy.txt => yyyy_1.txt
とか
  
xxyyzz.xls => yyzz.xls
xxxx_1.txt => _1.txt
とか
  
目的が不明瞭なので上記URLのサイトに詳細が書いてあります。としか案内しがたい状況です。
  
  
なお、本件ではFSOを使用する可能性が高いので使用する場合は参照設定から「Microsoft Scripting Runtim」にチェックを入れておいてください。

【追記】
前回のご質問に対してSuzu様からDir()を使用した再起処理の案内がありますが、
Dir()は文字数制限があり、入力できる文字数の上限を突破するとエラーになります。
 
もし処理の前後でファイル名が極端に長いものが含まれている場合、FSOを使用した処理に変更したほうが良いかもしれません。Dir（）の入力可能文字制限が256文字くらいだったと思います。
 

Dim FSO As Object
Dim TARGET As Object
Dim TEMP As Object

'ファイルリスト取得
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TARGET = FSO.GetFolder("探したいファイルまでのパス：例えばC:\FolderName")

For Each TEMP In TARGET.Files
	Debug.Print TEMP.Name
Next

' 後始末
Set FSO = Nothing

Dirは VB6時代の古い関数なので、色々と問題があります。
特に、Unicode非対応は致命的だと思います。
 
なので、FSOなどを使いましょう。
 
 
Dir関数の制限について
https://excel-ubara.com/excelvba4/EXCEL262.html
 
[プログラミング: VBA] Dir関数で環境依存文字のフォルダ名は正しく扱えない
https://note.com/skeccho/n/nee266138320f
 
 
なお、ファイル名の変更が目的なら、自作するより、フリーソフトの活用が現実的と思います。
 
 

オフィスTANAKA　Nameステートメント
http://officetanaka.net/excel/vba/statement/Name.htm
 
ちなみに一対一変換するだけなら上記サイトの内容をFOR文等でループするだけで済みます。
 

Sub Sample()
    Name "C:\Test.dat" As "C:\Sample.dat"         'Test.datをリネームします
    Name "C:\Sample.dat" As "C:\Tmp\Sample.dat"   'Sample.datをTmpへ移動します
End Sub

Sub LoopSample()
	Dim i As Long, x As Long, y As Long
	
	x = 1
	y = 1
	
	'（x,y）に置換元パス、その右隣に置換後パスがセルに格納されている想定（パスはファイル名まで含むフルパス）
	For i = 0 to n
		Name Cells(y + i,x).value As Cells(y + i,x + 1).value 
	Next i
End Sub

QooApp さん
MMYS さん
 
ご指摘ありがとうございます。
 
ダイアログでフォルダを指定し、FSO の再起処理を使用した
フォルダ/ファイル を ツリー表示するコードです。
 
ファイル名の変更は、Fileオブジェクトの Nameプロパティーを変える処理を入れてください。
https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/name-property-filesystemobject-object
 
どんな規則性でファイル名を変えるのか判りませんが正規表現を使うでしょうから Office TANAKA さんの
【正規表現によるマッチング】
http://officetanaka.net/excel/vba/tips/tips38.htm
を参考にファイル名変更処理を入れ込んでください。
 
-------------------------------------------------------------------------------------

Sub GetFolderTree()
  On Error GoTo Err_GetFolderTree
  Dim TargetPath As String
  Dim strPath As String
  Dim r As Long
  Dim c As Long
  Dim strMsg As String
  With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    If .Show = False Then strMsg = "キャンセルされました": GoTo Exit_GetFolderTree
    TargetPath = .SelectedItems(1)
  End With

  Cells.Delete
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Call GetSubFolders(FSO.GetFolder(TargetPath), 1, 1)
  strMsg = "終了"

Exit_GetFolderTree:
  Set FSO = Nothing
  MsgBox strMsg
  Exit Sub

Err_GetFolderTree:
  strMsg = Err.Number & vbCrLf & Err.Description
  GoTo Exit_GetFolderTree
End Sub

Private Sub GetSubFolders(ByVal Fld As Folder, ByRef r As Long, ByVal c As Long)
  Dim subFld As Scripting.Folder

  r = r + 1
  c = c + 1
  Cells(r, 1).value = "Folder"
  With Cells(r, c)
    .Font.Italic = True
    .value = Fld.Name
  End With

  For Each subFld In Fld.subFolders
    Call GetSubFolders(subFld, r, c)
  Next

  Call GetFiles(Fld, r, c)
  Set subFld = Nothing
End Sub

Private Sub GetFiles(ByVal Fld As Folder, ByRef r As Long, ByVal c As Long)
  Dim Fil As Scripting.File

  c = c + 1
  r = r + 1
  For Each Fil In Fld.Files
    Cells(r, 1).value = "File"
    Cells(r, c).value = Fil.Name
    r = r + 1
  Next
End Sub

ご回答ありがとうございます。
私のイメージの表現がまずかったので、再度みなさまから回答をいただけるよう的確な質問を
させていただきます。
下記マクロで、フォルダ内のファイル名をエクセルに書き出し、その後その名前をリネームでき
ました。
これを編集してサブフォルダ名を追加して、サブフォルダ名とファイル名を書き出し、その後
各サブフォルダ内のファイル名をリネームするマクロを教えてください。
（エクセル）（サブフォルダ名Ａ・Ｂ・Ｃは追加）
ファイル保存場所    
C:\Users\owner\Desktop\1.株式会社たくみ    
サブフォルダ名　ファイル名    　　変換後ファイル名
A　　　　　　　　�Q雇用契約書.pdf　1�Q雇用契約書.pdf
Ｂ　　　　　　　 �R賃金台帳.pdf     　1�R賃金台帳.pdf
Ｃ　　　　　　 　�S給与明細.pdf     　1�S給与明細.pdf
 
（マクロ）（サブフォルダ名の書き出しとサブフォルダ内のファイル名変更）
Sub get_file_name()
    '変数の型を宣言
    Dim folder_path As String
    Dim file_name As String
    Dim i As Integer
    folder_path = Cells(2, 1) & "\"
    file_name = Dir(folder_path, vbNormal)
    i = 1
    Do Until file_name = ""
        Cells(i + 3, 1) = file_name
        i = i + 1
        file_name = Dir()
    Loop
End Sub
Sub file_rename()
    '変数の型を宣言
    Dim folder_path As String
    Dim j As Integer
    folder_path = Cells(2, 1) & "\"
    j = 1
    Do Until Cells(j + 3, 1) = ""
        Name folder_path & Cells(j + 3, 1) As folder_path & Cells(j + 3, 2)
        j = j + 1
    Loop
End Sub

保存先フォルダが存在しない場合はフォルダを作成してブックを保存する
https://www.moug.net/tech/exvba/0060035.html
 
ファイルを移動する（Nameステートメント）
https://www.moug.net/tech/exvba/0060093.html

解決しました。有難うございます。