エクセルでのファイル名の一括変更 マクロ

質問

皆様お世話になります。
あるフォルダーの下位にユニークに名前の付けられた900個ほどのフォルダーがあり
それれぞれの、フォルダーの中にA,Bというフォルダーがあります。
その中にa.xls，b.xlsなどというファイルが存在しています。

そのa.xlsやb,xlsの名称を変換したいのですが数量が非常に多いためマクロか、何かで変更する方法がありますか？

ファイル名の条件として　開いたエクセルのC,4とH,4を合体させたファイル名にすると、非常にありがたいのですが。
よろしくお願いします。

回答No.28

ham_kamo · ベストアンサー

うまく読み込めたようでよかったです。あと一息ですね。

まず、ダイアログを出さないようにする変更点ですが、以下の、

　If MsgBox("NC(" & TMPFILE2 & ")がみつかりません。続行しますか？", _
　vbYesNo, "NCファイルエラー") = vbNo Then
　 MsgBox ("処理を中断しました。")
　 Exit Sub
　End If

をまるまるカットしてください。

そして、ログの書式変更ですが、このすぐ上の、

　If l1 = 3 Then
　 L.Cells(l1, 1) = "エラーが発生したファイル"
　 l1 = l1 + 1
　End If
　L.Cells(l1, 1) = "Ｚ表：" & FILE1
　L.Cells(l1 + 1, 1) = "NCファイル検索文字列：" & TMPFILE2
　l1 = l1 + 3

を、

　If l1 = 3 Then
　 L.Cells(l1, 1) = "エラーが発生したファイル"
　 L.Cells(l1 + 1, 1) = "Ｚ表"
　 L.Cells(l1 + 1, 2) = "NC検索文字列"
　 l1 = l1 + 2
　End If
　L.Cells(l1, 1) = FILE1
　L.Cells(l1, 2) = TMPFILE2
　l1 = l1 + 1

に置きかえてください。（ログシートの列の幅は適当に調節してください）

お礼

本当にありがとうございます。無事に完了しログも整理しやすい状態となりました。マクロは出来ると本当に便利ですね。少しぐらい出来るように頑張らないといけませんね。　今回のご協力いただいた内容を少しぐらいは理解出来るように頑張りたいと思います。
ありがとうございました。

回答No.7

ham_kamo

こんにちは、ham_kamoです。やはり一発ではうまくいかないものですね。１つ１つかたづけていきましょう。

●補足要求１
> １、「ファイル名一覧作成」では　現状のマクロを置く位置を
> ファイルが入っているフォルダの１つ上に置かないとだめなんですね。

とのことですが、私は「現状のマクロを置く位置」というのが、この質問文に出てくる「あるフォルダ」だと思っていたのですが、そうではなかったのでしょうか。

マクロでは「同じフォルダ内のファイルしか結びつけることができない」から「あるフォルダ」より下の階層にあるファイルをとりあえず全部「あるフォルダ」に持ってくる、そこでマクロも動かす、と思っていました。

マクロはどこのフォルダで動くのでしょうか。「あるフォルダ」の下に900個くらいのフォルダがある、とありますが、その900個のフォルダそれぞれでマクロを動かすのでしょうか？そうすると、ファイルを移動させる先も「あるフォルダ」でなく、その１段下のフォルダになるのでしょうか。

つまり、先の回答のマクロでは、

あるフォルダ\folder1\A\a.xls
を
WorkPathで指定したパス\aa1.xls　（aa1.xlsは変更された名前）
に移動

と処理するようになってますが、そうでなくて、

あるフォルダ\folder1\A\a.xls
を
あるフォルダ\folder1\aa1.xls
に移動

にする、ということでしょうか。

●補足要求２
> 現在頂いたファイルと同じ場所に4つのフォルダを置いてテストしています
> そのうち、１つはフォルダ直下にエクセルファイルがあります
> それは、リストには出ていません。

えっと、900個くらいフォルダがあって、その下にA,Bフォルダがあって、さらにその下にエクセルファイルがあると思っていたのですが、それだけでなくA,Bフォルダと同じ階層にもエクセルファイルがある、ということでしょうか。

上と同じ書き方をすると、

あるフォルダ\folder1\A\a.xls
あるフォルダ\folder1\B\a.xls
以外に、
あるフォルダ\folder1\a.xls

というパターンもあるということですか？

> あとシート１のセル幅がノーマルのためパスが分かりずらい感じです

すみません、シート保護をしたらセルの幅も変えられないのでした。これは自動的に幅を調整するように処理を追加します。

> ２、「ファイル名の変更と移動」では実行時エラー５３　ファイルが見つからないとなり

あ、これは、
WorkPath = "C:\Documents and Settings\*****\My Documents\test\z"

を

WorkPath = "C:\Documents and Settings\*****\My Documents\test\z\"

と最後に"\"を入れてください。

とりあえず、上記で挙げた、確認させていただきたい点の補足をいただいてからマクロを修正するので、とりあえず補足をお願いいたします。

お礼

'エクセルファイルを開く
Workbooks.Open Filename:=ThisWorkbook.Path & "\work.xls"
Set s = Range("A1:A3000")
m = 1
k = 0
Do Until s.Cells(m, 1) = "" Or k <> 0
If Trim(s.Cells(m, 1)) = "MACHINE=MPAV" Then 'NCファイルからマシン名を探す
MACHINE = "MPAV"
k = 1
ElseIf Trim(s.Cells(m, 1)) = "MACHINE=MV2F" Then
MACHINE = "MV2F"
k = 1
ElseIf Trim(s.Cells(m, 1)) = "MACHINE=MV2C" Then
MACHINE = "MV2C"
k = 1
End If
m = m + 1
Loop

m = 1
k = 0
Do Until s.Cells(m, 1) = "" Or k <> 0
If Trim(s.Cells(m, 1)) = "%SETUP" Then 'NCファイルから"%SETUP"を探す
k = m
End If
m = m + 1
Loop

補足

こんばんわ　度々申し訳ありません
１　testというフォルダを作りその下にｚと言うフォルダを作成しました。
そのzの中に対象となる5つのフォルダを入れた状態の場合
現在作成中のマクロを勝手ながらkhamとファイル名にさしていただいてますが
c:\temp\\z\ここに５つのフォルダABCDEとします
tempの階層にkhamを置いて走らせた場合は\Aの直下にエクセルがある場合は一覧表示に出てきますので　ｚの位置にkhamを置くと\B\a.xlsと表示されますが\Aは表示されません　たぶんイレギュラーだとは思うのですがたまたまテストに使用したフォルダーがそのようになっていました。
こんなのにも、対応可能なのでしょうか？
２、「ファイル名の変更と移動」ではパスをC:\temp\z\にしましたが
Name RootPath & R.Value As WorkPath & R.Offset(0, 1).Value
の所が黄色の反転で同一エラーで停止します

補足になりましたでしょうか？

回答No.6

ham_kamo

No.4のham_kamoです。

とりあえず、書かれた仕様で、１つのフォルダにファイルを集めるマクロを組んでみました。エクセルファイルの場合はC4セルとH4セルを元に名称を変更し、その他のファイルの場合はそのまま移動します。

質問文で書いている「あるフォルダ」に新しいブックを作成し、Alt+F11でVBAの画面を開き、標準モジュールを追加して以下のマクロをコピーして貼り付けてください。

Sub ファイル名一覧作成()
　Dim RootPath As String
　Dim i As Integer, j As Integer
　Dim R As Range
　Dim FSO As Object
　Dim D As Object, F As Object

　Set FSO = CreateObject("Scripting.FileSystemObject")
　RootPath = ThisWorkbook.Path & "\"

　Application.ScreenUpdating = False
　Worksheets("Sheet1").Unprotect
　Worksheets("Sheet1").Activate
　Cells.ClearContents

　i = 1: j = 1
　For Each D In FSO.GetFolder(RootPath).SubFolders
　　Application.StatusBar = j & "フォルダ処理中"
　　Cells(i, "A").Value = D.Name & "\"
　　i = i + 1: j = j + 1
　Next

　i = 1
　For Each R In Range("A1", Cells(Rows.Count, "A").End(xlUp))
　　For Each D In FSO.GetFolder(RootPath & R.Value).SubFolders
　　　Application.StatusBar = j & "フォルダ処理中"
　　　Cells(i, "B").Value = R.Value & D.Name & "\"
　　　i = i + 1: j = j + 1
　　Next
　Next

　i = 1: j = 1
　For Each R In Range("B1", Cells(Rows.Count, "B").End(xlUp))
　　For Each F In FSO.GetFolder(RootPath & R.Value).Files
　　　Application.StatusBar = j & "ファイル処理中"
　　　Cells(i, "C").Value = R.Value & F.Name
　　　If StrConv(F.Name, vbLowerCase) Like "*.xls" Then
　　　　With ActiveSheet
　　　　　Workbooks.Open (RootPath & Cells(i, "C").Value)
　　　　　.Cells(i, "D") = Worksheets(1).Range("C4").Value & _
　　　　　Worksheets(1).Range("H4").Value & ".xls"
　　　　　Workbooks(Workbooks.Count).Close
　　　　End With
　　　Else
　　　　Cells(i, "D").Value = F.Name
　　　End If
　　　i = i + 1: j = j + 1
　　Next
　Next
　Set FSO = Nothing
　Worksheets("Sheet1").Protect
　Application.StatusBar = ""
　Application.ScreenUpdating = False
　MsgBox ("完了しました")
End Sub

Sub ファイル名の変更と移動()
　Dim RootPath As String, WorkPath As String
　Dim R As Range
　RootPath = ThisWorkbook.Path & "\"
　WorkPath = "C:\temp\zzz\" 'ファイルを集めるフォルダを指定
　With Worksheets("Sheet1")
　　If .Range("A1") = "" Then Exit Sub
　　For Each R In .Range("C1", Cells(Rows.Count, "C").End(xlUp))
　　　Name RootPath & R.Value As WorkPath & R.Offset(0, 1).Value
　　Next
　End With
End Sub

Sub ファイル名を元に戻して元のフォルダに移動()
　Dim RootPath As String, WorkPath As String
　Dim R As Range
　RootPath = ThisWorkbook.Path & "\"
　WorkPath = "C:\temp\zzz\" 'ファイルを集めるフォルダを指定
　With Worksheets("Sheet1")
　　If .Range("A1") = "" Then Exit Sub
　　For Each R In .Range("C1", Cells(Rows.Count, "C").End(xlUp))
　　　Name WorkPath & R.Offset(0, 1).Value As RootPath & R.Value
　　Next
　End With
End Sub

上記２箇所に「'ファイルを集めるフォルダを指定」と注釈のついたところがあります。そこのフォルダ名は実際のフォルダ名に書き換えてください。

上記マクロは
「ファイル名一覧作成」
「ファイル名の変更と移動」
「ファイル名を元に戻して元のフォルダに移動」
の３つのプロシージャがあります。

「ファイル名一覧作成」を実行すると、サブフォルダのサブフォルダを探して、ファイル一覧をSheet1に作ります。A列にサブフォルダ一覧、B列にサブフォルダのサブフォルダ一覧、C列にB列の中で見つかったファイルの名称、D列に新しいファイル名を出力します。

それを実行した後、
「ファイル名の変更と移動」を実行すると、作成したファイル名一覧に基づき、ファイルをリネームしながら一箇所に移動します。

「整理番号を元に型番と品番と結びつけるマクロ」の処理が終わった後、「ファイル名を元に戻して元のフォルダに移動」を実行すると、集めたファイルを元のフォルダに戻し、ファイル名も元に戻します。ただし、Sheet1のファイル名一覧はこれを実行するまでに書き換えたりしないでください。（一応書き換えられないようにシート保護をかけています）

最初は900個もある本物のファイルで試すより、テスト用に一部のフォルダをコピーして動作確認をした方がよいでしょう。うまく動かない、あるいは何か不明な点があれば補足をお願いします。

お礼

'形状コードを探す
n = p_org
Do Until r.Cells(n, 1) = ""
r.Cells(n, 6) = MACHINE
m = k + 1 '"%SETUP"の次の行
z = 0
Do Until s.Cells(m, 1) = "" Or z = 1
St = s.Cells(m, 1)

x = InStr(St, "Z")
y = InStr(St, "P")

St2 = Mid(St, Start:=x + 1, Length:=y - x - 1)

If Trim(St2) = Trim(r.Cells(n, 1)) Then
x = InStr(St, "(")
y = InStr(St, ")")
z = 1

St3 = Mid(St, Start:=x + 1, Length:=y - x - 1)
r.Cells(n, 3) = St3
End If

m = m + 1
Loop
If z = 0 Then
MsgBox "Z=" & r.Cells(n, 1) & "がNCファイルに見つかりません"
End If
n = n + 1
Loop

Else
MsgBox "NCファイルとZ表があっていません"
End If

End If

Else
MsgBox "NCファイルが見つかりません"
End If
End With

Workbooks("work.xls").Close SaveChanges:=False

あと少しあるのですが入れるものが無いのでこれぐらいです

補足

ありがとうございます返答が非常に遅くなり申し訳ありません。
テスト結果ですが
１、「ファイル名一覧作成」では　現状のマクロを置く位置をファイルが入っているフォルダの１つ上に置かないとだめなんですね。
現在頂いたファイルと同じ場所に4つのフォルダを置いてテストしています
そのうち、１つはフォルダ直下にエクセルファイルがあります　それは、リストには出ていません。
それ以外のものは、フォルダ下にフォルダがありその中にエクセルファイルがあるので表示されています。
あとシート１のセル幅がノーマルのためパスが分かりずらい感じです
２、「ファイル名の変更と移動」では実行時エラー５３　ファイルが見つからないとなり　
Name RootPath & R.Value As WorkPath & R.Offset(0, 1).Value
が反転されています。
WorkPath = "C:\Documents and Settings\*****\My Documents\test\z"
の位置にマクロファイルを置いていますが　だめです
すみません

回答No.5

Dxak

> このマクロを実行するには、先にファイルの置いてある場所や保存する
> 名称を記入しておくと言うことになるのでしょうか？

最初のファイル名が判らないと、どれをどれに変更するか判らないでしょ＾＾；

と、言う事で先に、ファイル名およびフォルダの変更前、変更後の一覧を作る必要があります
変更前に関しては下位のフォルダも検索して・・・等、考えると面倒なので・・・

フリーソフトで、ファイル名一覧で、ＣＳＶで作成可能なもので代用された方が、簡単だと思いますよ

回答No.4

ham_kamo

こんにちは。これは
http://oshiete1.goo.ne.jp/kotaeru.php3?qid=2846439
の質問の続きですね。

やりたいことはだいたいわかったのですが、まだ不明な点があるので、確認させてください。

・上記URLの質問では、マクロが同じフォルダー内でないと動作しないため、たくさんのフォルダーに散らばっているテキストファイルとエクセルファイルをいちいち手で移動させているので、それをマクロでできないか、ということだったと思うのですが、この質問では「名称変更」のやり方を質問されていますね。同じドライブ内ならファイル名の変更もファイルの移動も同じ事なので、これは「名称変更して、マクロを動かすフォルダに移動」ということでよろしいでしょうか。

・この質問ではエクセルファイルについてしか書かれていませんが、前の質問ではテキストファイルもマクロを動かすフォルダに手で移動させて、と書いていました。これもマクロで自動的に移動させた方がよいのでしょうか。

・その場合、テキストファイルの場合はフォルダはたくさんあるけどファイル名は全部違うとありますが、テキストファイルが保存されているフォルダはどこにあるのでしょうか。質問文では

「あるフォルダ」＞「900個のフォルダ」＞「A,Bというフォルダ」＞エクセルファイル

という階層構造になっていますが、テキストファイルはこの中でどこにあたるのでしょうか。

・整理番号を元に型番と品番と結びつけるマクロを動かす（そのマクロの入っているブックがある）フォルダは、質問文冒頭の「あるフォルダー」なのでしょうか。それとも他にワーク用のフォルダがあるのでしょうか。

・上記マクロを動かした後、移動（名称変更）したエクセルファイル、テキストファイルは元のフォルダ、元のファイル名に戻すのでしょうか？

以上の点を補足願えますか？

補足

ありがとうございます。あちらもこちらもすみません。
１、マクロは同一フォルダー内でしか動作できません。
２、名称変更の理由としては、散らばっているファイルが同一名称のためです。
もし、名称変更ができれば、それぞれのファイル名（テキスト，エクセル）で関連性を持たせることで　それを元に処理する方が楽ではないかと思ったからです。
３、テキストもマクロを動かすフォルダに動かしています。
４、テキストも　あるフォルダ＞850個ほどのフォルダ＞フォルダ＞ファイル
５、テキストファイルと言っていますが、拡張子は付いていません。
６、動作させるマクロファイルは特に指定された場所にはありません。

７、エクセルのファイルも「Ａ，Ｂ」とフォルダ名称を書きましたが実際は異なる名称です　しかし２つあるのは確かです。

すみません、補足になりましたでしょうか？　
余計にわけがわからなくなってしまったかも知れませんね。

現在、テキストは同一名称ではないため　1つのフォルダーに入れてしまおうかと考えていますが・・・・・・

回答No.3

Dxak

モジュール的には、そんなに難しいものでは、ありません
ファイル名の一覧を取得するモジュールは、作成してませんが・・・

Sub usFileReName()
On Error Resume Next

Dim I As Long
Dim usBePath, usBeName As String
Dim usAfPath, usAfName As String

I = 2

With ActiveSheet
usBePath = .Cells(I, 1)
usBeName = .Cells(I, 2)
usAfPath = .Cells(I, 3)
usAfName = .Cells(I, 4)
While usBePath & usBeName <> ""
If Dir(usBePath & "\" & usBeName) = "" Then
.Cells(I, 5) = "File Not Found"
Else
If Dir(usAfPath & "\" & usAfName) = "" _
And usAfPath & usAfName <> "" Then
Name usBePath & "\" & usBeName As usAfPath & "\" & usAfName
.Cells(I, 5) = "File ReName Complete"
Else
.Cells(I, 5) = "File Not ReName"
End If
End If
I = I + 1
usBePath = .Cells(I, 1)
usBeName = .Cells(I, 2)
usAfPath = .Cells(I, 3)
usAfName = .Cells(I, 4)
Wend
End With

End Sub

で、ある程度は、可能だと思いますが置き換え後の「ファイル名が不正の場合」の検出をどうするか？考えてないので、その当りは注意してください
Ａ列から変更前のパス、Ｂ列から変更前のファイル名を読み取り
Ｃ列から変更後のパス、Ｄ列から変更後のファイル名を読み取り
Ｅ列に変換結果を出力しています

> .Cells(I,?)
の部分を差し替えてやれば、希望した列から読み取ります
> I=2
の部分で、１行目はタイトルが付いている前提で読み飛ばしてあります

で、モジュールってある程度わかります？

お礼

ありがとうございます。
モジュールはほんの少ししか・・・・・
このマクロを実行するには、先にファイルの置いてある場所や保存する名称を記入しておくと言うことになるのでしょうか？

すみません、勉強不足で・・・・

回答No.2

Dxak

エクセルマクロで、実施する理由は何でしょうか？

Vector
Download: Windows > ユーティリティ > ファイル管理 > ファイル名変更:
http://www.vector.co.jp/vpack/filearea/win/util/file/name/

みたいに、フリーソフトで、たくさんありますが・・・

データベース化したいとか？
別のデータで名前を参照して書き換えたいとか？

お礼

ありがとうございます。
お察しのとおり、別データで名前を参照して中身の特定部分を使用し対のです。

回答No.1

noname#95859

小生がいつもやっている手ですが、
DOSpromptにて、ディレクトリをとります。
それを、excelで開いて、エクセル画面上で修正、
DOS batch fileを作ります。
具体的に

DOS promptにて、該当フォルダ”あるフォルダ”をカレントとします。
手順は、DOS promptの画面で、まず、
>C:リターン
>cdスペース
と打って、その一方で、エクスプローラを開いて、”あるフォルダ”をドラッグしてDOS prompt画面に持ってきます。
>cd C:\xxxxxxxxxxxxxxxxxxxxxxxx\あるフォルダ　　リターン
これで、”あるフォルダ”をカレントにできました。
次に、
>dir /s/b/o >mylist.txt
と打ちます。

エクセルからmylist.txtを開く
エクセル画面にて
ren oldname newname
oldname ----- 絶対パスです。
newnameも絶対パスとします。

と言った感じで、編集します。newnameは、「C,4とH,4を合体させたファイル名」
最後に、saveasで、DOS(tab)で保存します。
エクスプローラにて、ファイル名を　mylist.batに変更します。
mylist.batをダブルクリックすれば、バッチファイルが動作します。
尚、実行前にバックアップを取っておいてください。

お礼

ありがとうございます。
ちょっと私には、敷居が高いように思います