お勉強コミュの自作VBA

フォルダーのファイル名をExcelに書き出し
書き出したとなりのセルの値(名前)に書き換える
Option Explicit


'Dim ドライブ As String 'フォルダが存在するドライブ
Dim フォルダ As String 'フォルダ名
Dim 拡張子 As String 'ファイルタイプ（拡張子）
Dim 記入シート As String 'ファイル名を記入するシート名
Dim パス As String 'パス
Dim ファイル名 As String 'ファイル名の取り出しエリア
Dim 貼付行 As Integer '貼付行ポインタ
'-----------------------------------------------------------------------------------------
Sub フォルダ中のファイル名をシートに書く()
'ドライブ = "C" 'ドライブを指定する
'フォルダ = "\Documents and Settings\Miyashita．Co，\デスクトップ\リネーム" 'フォルダ名を指定する

フォルダ = Cells(2, 1).Value


'拡張子 = "*." & "jpg" '拡張子を指定する（この例はtxtまたはTXT）

拡張子 = Cells(5, 1)

記入シート = "ファイル一覧" 'ファイル名の記入用シートを指定する
指定フォルダ中の指定拡張子のファイル名をシートに書く
End Sub
'-----------------------------------------------------------------------------------------
Private Sub 指定フォルダ中の指定拡張子のファイル名をシートに書く()
Sheets(記入シート).Activate 'ファイル名を記入用シートをアクティブにする
Range("B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents 'すべてクリア
Range("C1").Select
'パス = ドライブ & ":\" & フォルダ & "\" 'パスを組む

パス = フォルダ & "\"


ファイル名 = Dir(パス & 拡張子) '指定された拡張子のファイル名を取り出す
貼付行 = 0 '貼付行ポインタを初期化する
'
Do While ファイル名 <> "" '取り出したファイル名がヌルでなければ
貼付行 = 貼付行 + 1 '貼付行ポインタを上げる
Cells(貼付行, 2).Value = ファイル名 'セルにファイル名を記入する
ファイル名 = Dir() '次のファイル名を取り出す
Loop '繰り返し処理
End Sub
--------------------------------------------------------

Sub リネーム()


Dim i As Long
Dim NEWファイル As String
Dim OLDファイル As String
Dim パス As String


For i = 1 To Range("B65536").End(xlUp).Row


パス = Cells(2, 1).Value & "\"

OLDファイル = パス & Cells(i, 2).Value
NEWファイル = パス & Cells(i, 3).Value



If Dir(OLDファイル) <> "" Then
Name OLDファイル As NEWファイル

End If

Next i
End Sub