エクセル VBA ファイルをフォルダへ移動させる

質問

エクセル　VBA　手探り状態です。
001大企業.xls、001中小企業.xls、003大企業.xls、003中小企業.xls、008大企業.xls、008中小企業.xls・・・・というファイルが300ほど企業種類という名前のフォルダにあります。
VBAで企業種類という名前のフォルダの中に、001、003、008・・・というフォルダは作成しました。
（ネットで”フォルダ作成”を検索して、、、自力ではVBAは書けません）
それを001という名前のフォルダへは、001大企業.xls、001中小企業.xlsのファイル、003という名前のフォルダへは003大企業.xls、003中小企業.xlsのファイルを、008フォルダへは008大企業.xls、008中小業.xlsファイルを・・・というように、マクロで移動させたいのです。
これらのファイル、フォルダは全て、企業種類というフォルダの中にあります。
VBAを教えていただけましたら嬉しいです。

回答No.2

web2525

じゃ簡単に
ファイル名取得の方から

Dim buf As String, cnt As Long
Const Path As String = "C:\～\～\企業種類\"←これを企業種類フォルダのフルパス+\に変更
buf = Dir(Path & "*.xls")
Do While buf <> ""
　　ファイル移動処理
buf = Dir()
　Loop
フォルダ内のエクセルファイル名を順に取得する動作の中に

ファイル移動処理が

cno = Left(buf, 3)
Name Path & buf As Path & cno & "\" & buf

取得したファイル名が"001大企業.xls"だった場合
As Path &　"\" & cno = C:\～\～\企業種類\001　となるので
C:\～\～\企業種類\001\001大企業.xls　として移動する処理

組合させた結果が

Sub Sample()
Dim buf As String, cnt As Long
Const Path As String = "C:\～\～\企業種類\"
buf = Dir(Path & "*.xls")
Do While buf <> ""
　　cno = Left(buf, 3)
Name Path & buf As Path & cno & "\" & buf
buf = Dir()
　Loop
End Sub

となるのですが、コレでほんとに希望動作になるかは検証していない
（Dirで呼び出したファイルが消えた場合次のDirの動作が正常に動くのかが自信ない）

ファイルのコピーではなく移動なので、元のデータが中途半端に移動したり、消えたりする可能性があるので、元フォルダーの中身の一部をコピーしたフォルダーで動作試験を行ってから元フォルダでの実行をお薦めします

お礼

ご親切にありがとうございます。
これから試してみます。

回答No.1

web2525

フォルダ内のファイル名取得

http://officetanaka.net/excel/vba/file/file07.htm

ファイルの移動

http://officetanaka.net/excel/vba/statement/Name.htm

この２つを組み合わせればできます

お礼

早速の回答ありがとうございます。
フォルダにある、001大企業.xls、001中小企業.xls・・・のファイルをシートに一覧表示して、そのファイルを001、002・・・フォルダへ移動させるということでしょうか。
本当に手探り状態なので、VBAをどう繋げてよいかわかりません。
応用できないのです。
具体的に教えていただけたらうれしいです。