![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
多量のファイルをフォルダに自動振り分けするマクロを教えて下さい。
エクセルVBAで、一行の内容を1つのテキストファイルに出力して、
連続処理で複数行を一気に複数ファイルに生成しています。
そのマクロは以前質問して教えて頂いたマクロで、下記のアドレスから
ご覧くださいませ。
http://oshiete.goo.ne.jp/qa/6201310.html
ファイル生成のマクロは、回答No.2の方が教えてくれたマクロを採用し
ています。(ベストアンサー)
生成するファイル名は4桁の数字なんですが、ファイル自動生成時に、
ファイル名が1000番代のファイルは、フォルダ名が1のフォルダに収め、
2000番代は2のフォルダへ・・といった具合に9000番代まで収めたいのです。
ファイルは生成できているので、 あとはフォルダの自動生成と
自動振り分けができるマクロを教えて頂けませんか?
宜しくお願い致します。
No.3ベストアンサー
- 回答日時:
内容を換えました。
このマクロの特徴は、2列目を使うファイル名は4桁の数--つまり数字であるということ。
フォルダが見つからないと、マクロはストップしてしまいます。
'//
Sub TestMacro1()
Dim i As Long, k As Variant, j As Long, m
Dim fn As String
Dim mPath As String, nPath As String
Dim rng As Range, ar As Variant
Dim buf As String
Set rng = Range("A1", Cells(Rows.Count, 1).End(xlUp).Offset(, 2))
'パスを決める(CurDir は、カレントディレクトリ)
mPath = CurDir & "\" '末尾には必ず¥を入れます。
ar = rng.Value
For i = 1 To rng.Rows.Count
fn = Format(ar(i, 2), "0000") & ".txt"
nPath = mPath & Left$(fn, 1) & "\"
If Dir(nPath, vbDirectory) = "" Then MsgBox "Folderが見つかりません", 48: Exit Sub
Do Until Dir(nPath & fn) = ""
k = Val(k) + 1
j = InStr(1, fn, "(", 1)
If j > 0 Then
'同名ファイルの場合
fn = Mid(fn, 1, j - 1) & "(" & k & ")" & ".txt"
Else
fn = Replace(fn, ".txt", "", , , 1) & "(" & k & ")" & ".txt"
End If
Loop
Open nPath & "\" & fn For Output As #1
Print #1, ar(i, 1) & ar(i, 2) & ar(i, 3)
Close #1
k = ""
nPath = ""
Next
If Len(buf) > 2 Then
MsgBox Mid(buf, 2) & vbCrLf & "重複のため保存は省かれました。"
Else
MsgBox mPath & "に出力されました。"
End If
End Sub
No.2
- 回答日時:
勉強(と言ってもWEB照会してコードをさがす程度)をせず、全面的に回答頼りになっていませんか。
個別要素のコードは、良くある例なので、WEB照会で直ぐ見つけられます。
前問の回答にも使えるものがあります。前問の回答の周辺事項が身についてないのでは。回答コピーで動けば良しとするからでしょう。
(1)在るフォルダのすべてのフォルダを採り上げるコード
(2)新規にフォルダを作成し、望みのフォルダ名にするコード
(3)振り分けの判別(ファイル名の文字列の一部を切り出し、IF分を使うだけ)
(4)ファイルをコピーして指定のフォルダに入れるコード
などGoogleででも照会すれば、沢山ありますよ。
照会のキーワードは
(1)VB Dir
(2)VB Mkdir
(3)Mid関数
(4)VB copy
http://homepage1.nifty.com/rucio/main/Samples/s_ …
日本語で、例えば(2)は「VB フォルダ作成」などで照会しても良い
ーー
本質問については、それぞれFSO(FileSystemObject)のコードでやる方法もあります。
(4)はMoveFileもある。
No.1
- 回答日時:
>ファイルは生成できているので、 あとはフォルダの自動生成と
>自動振り分けができるマクロを教えて頂けませんか?
この手の質問に回答するのはかなり度胸が必要なのですよ。
間違ったコードや操作でパソコンの中をめちゃくちゃにしてしまう可能性もあるからです。
参考程度の回答を致します。
失敗の事を考えて2つのステップで操作します。
ステップ1
指定したフォルダ内のファイル名をエクセルのシートに一覧で表示させます。
ステップ2
表示されたファイル名を別のフォルダーにコピィする。
ステップ3
うまく出来たらフォルダ内のファイルを削除する。
それぞれがうまく出来るか確認の上。次のステップに進んでください。
ステップ1
B2セルに ファイルが入っているフォルダ名を入れておきます。
Sub ボタン1_Click()
Dim Buf As String
Range("C3:D1000").ClearContents
Buf = Dir(Range("B2").Value & "\" & "*.*")
i = 3
Do While Buf <> ""
Range("C" & i).Value = Buf
Range("D" & i).Value = Left(Range("C" & i).Value,1)
Buf = Dir()
i = i + 1
Loop
End Sub
DirについてはWeb調べると色々と説明がされています。
C3セル以下にファイル名の一覧
D3セル以下にはファイル名の最初の1文字がでます。
Sub ボタン2_Click()
For i=3 To Range("C65536").End(Xlup).Row
FileCopy Range("B2").Value & "\" & Rnage("C" & i).Value, Range("D" & i).Value & "\" & Range("C" & i).Value
Next
End Sub
FileCopy コピィ元のパスとファイル名,コピィ先のパスとファイル名 と指定して使います。
B2セルで指定したフォルダ(パス)で
C列のファイル名を D列で指定したフォルダへ C列で指定したファイル名コピィします。
簡単なコードですので、ご自身で理解して使ってください。
お酒も履いてしまっているので スペルミスなどもあるかもしれません。
検証もしていていませんの保証もいたしません。
ご自身の責任で実行してください。
そういう懸念があったのですね。。
確かに出力すると数千ファイルが生成されるので、
間違った場合の削除にも手間がかかりました。。
教えて頂いたこと、慎重に検証させていただきますね^^
ありがとうございます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 【マクロ】エラーが発生⇒実行時エラー58既に同名のファイルが存在 5 2022/08/31 10:03
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/08/08 11:02
- Excel(エクセル) 【VBAファイル移動】2つのマクロを順に実行。1つ目のマクロが実行不可⇒2つ目が実行不可となる件 2 2022/07/29 12:17
- Visual Basic(VBA) エクセルのマクロについて教えてください 物件ごとのフォルダを作成してます そのフォルダ内にサブフォル 2 2023/07/02 17:58
- Excel(エクセル) 2つのマクロを連続して動かしたい 3 2022/09/20 23:46
- Visual Basic(VBA) Wordマクロで指定したフォルダ名に保存する方法について 8 2022/12/13 11:35
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/02/21 09:28
- Excel(エクセル) 【VBA】フォルダAにある2つのファイルの内1つを、フォルダBへ。もう1つを、フォルダBへ移動したい 6 2022/07/26 08:51
- Excel(エクセル) 【マクロ】ファイルを古い順に、1個ずつ移動する 1 2022/09/06 20:30
- Excel(エクセル) Excel、同じフォルダ内のExcelファイルの特定シートのみを1つのファイルに集約したい 8 2022/09/07 15:12
このQ&Aを見た人はこんなQ&Aも見ています
-
「どうして捨てられないの?」前妻の物を捨てられない男性の心理って?
前妻の物を捨てられない理由に加え、捨てるための手段はあるのかを専門家に聞いてみた!
-
ファイル名と同名のフォルダを自動作成して移動させる方法はありますか?
Access(アクセス)
-
エクセルVBA テキストに出力、名前を付けて保存
Excel(エクセル)
-
ファイル名から該当フォルダへ移動
Visual Basic(VBA)
-
-
4
サブフォルダー内のPDFファイルを別フォルダにコピーするVBA
Excel(エクセル)
-
5
VBA フォルダ名に特定の文字を含むフォルダを別フォルダにコピーするコードを教えて下さい
Visual Basic(VBA)
-
6
ExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。
Visual Basic(VBA)
-
7
Excel VBA ファイルコピー後フォルダ振り分けについて
Visual Basic(VBA)
-
8
サブフォルダ内のファイルを全部移動させたい。
Visual Basic(VBA)
-
9
【マクロ】ファイル名の日付によって、保管するフォルダを、自動選択したい
Excel(エクセル)
-
10
あるフォルダーのファイルを違う親フォルダーのサブフォルダーに移したい
Visual Basic(VBA)
-
11
バッチファイル 別ファイルにリストしてあるファイルをコピーしたい
その他(プログラミング・Web制作)
-
12
日付を入力したセルをファイル名にして保存するには
Excel(エクセル)
-
13
ファイルをフォルダに自動振り分け バッチファイル
その他(プログラミング・Web制作)
-
14
【EXCEL】【VBA】空欄は飛ばして処理する方法を教えて下さい。
Excel(エクセル)
-
15
ファイルをフォルダに自動で振り分けてくれるソフトやパッチを知りたい
その他(ソフトウェア)
-
16
Windowsで複数のファイルを同じ名前のフォルダーに振分ける方法を教えてください。
Microsoft ASP
-
17
テキストボックス(VBA)でEnterを押したときに作動するマクロ
Access(アクセス)
-
18
マクロでセルを1行下に移動する方法
Excel(エクセル)
-
19
エクセルの色も=イコールできますか?
Windows Me・NT・2000
-
20
VBAを使って検索したセルをコピーして別の場所に貼り付ける。
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Windows10でコマンドプロンプト...
-
VBA フォルダ名に特定の文字を...
-
VBA 最新のフォルダ取得
-
Access VBA で フォルダ権限...
-
ファイル名と同名のフォルダを...
-
C ファイル出力で、フォルダが...
-
【マクロ】ファイル名の日付に...
-
エクセルのマクロについて教え...
-
excel VBA Dirにて検索したフォ...
-
VBA フォルダ名と画像ファイル...
-
バッチファイルで指定フォルダ...
-
条件に合うフォルダが存在する...
-
VBScriptでフォルダ参照ダイア...
-
VBSでファイル名と同じフォルダ...
-
Debug フォルダは消していいの?
-
デスクトップの画像をhtmlに表...
-
vbsで選択ダイアログを表示した...
-
フォルダ内のPDFファイル名を変...
-
ExcelVBAでフォルダへのハイパ...
-
Excel VBA マクロ リストボックス
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Windows10でコマンドプロンプト...
-
VBA 最新のフォルダ取得
-
バッチファイルが保存されてい...
-
ファイル名と同名のフォルダを...
-
【マクロ】ファイル名の日付に...
-
VBA フォルダ名に特定の文字を...
-
デスクトップの画像をhtmlに表...
-
フォルダ内のPDFファイル名を変...
-
ディレクトリ名変更してコピー...
-
多量のファイルをフォルダに自...
-
Excelで指定したフォルダに保存...
-
Access VBA で フォルダ権限...
-
C ファイル出力で、フォルダが...
-
Excelのハイパーリンクについて...
-
あるフォルダーのファイルを違...
-
パス名に2バイト文字(マルチバ...
-
同一フォルダ内の別ブックから...
-
エクセルのマクロについて教え...
-
バッチファイルで指定フォルダ...
-
ExcelのVBAでフォルダ指定がで...
おすすめ情報