多量のファイルをフォルダに自動振り分けするマクロを教えて下さい。
エクセル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も見ています
-
性格の違いは生まれた順番で決まる?長男長女・中間子・末っ子・一人っ子の性格の傾向
同じ環境で生まれ育っても、生まれ順で性格は違うものなのだろうか。家庭教育研究家の田宮由美さんに教えてもらった。
-
エクセルVBA テキストに出力、名前を付けて保存
Excel(エクセル)
-
ファイル名と同名のフォルダを自動作成して移動させる方法はありますか?
Access(アクセス)
-
ファイル名から該当フォルダへ移動
Visual Basic(VBA)
-
-
4
Excel VBA ファイルコピー後フォルダ振り分けについて
Visual Basic(VBA)
-
5
VBA フォルダ名に特定の文字を含むフォルダを別フォルダにコピーするコードを教えて下さい
Visual Basic(VBA)
-
6
ファイルをフォルダに自動振り分け バッチファイル
その他(プログラミング・Web制作)
-
7
サブフォルダー内のPDFファイルを別フォルダにコピーするVBA
Excel(エクセル)
-
8
EXCEL VBA セルに既に入力されている文字に文字を追加する
Excel(エクセル)
-
9
エクセルVBAで、条件に一致するセルへ移動
Excel(エクセル)
-
10
セルの値と同じ名前のシートをアクティブにするには?
Excel(エクセル)
-
11
バッチファイル 別ファイルにリストしてあるファイルをコピーしたい
その他(プログラミング・Web制作)
-
12
エクセルの色も=イコールできますか?
Windows Me・NT・2000
-
13
ExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。
Visual Basic(VBA)
-
14
EXCEL VBAで、セルの文字列の前後に文字を入力する方法は?
その他(Microsoft Office)
-
15
EXCELのVBAでRange(A1:C4")を変数にする方法を教え"
Visual Basic(VBA)
-
16
excelのマクロで該当処理できなければ飛ばして進むにはどうすればよいのでしょうか
Visual Basic(VBA)
-
17
Windowsで複数のファイルを同じ名前のフォルダーに振分ける方法を教えてください。
Microsoft ASP
-
18
ExcelのVBA:フォルダ内のファイルを次の条件で自動でフォルダ分けができませんでしょうか?
Excel(エクセル)
-
19
エクセルVBAで一つ上の階層を指定して保存したい
Excel(エクセル)
-
20
ファイルと同名のフォルダに移動するには?
その他(パソコン・スマホ・電化製品)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Windows10でコマンドプロンプト...
-
windowsでテキストファイルの各...
-
パス名に2バイト文字(マルチバ...
-
vbsで選択ダイアログを表示した...
-
Excelで指定したフォルダに保存...
-
C ファイル出力で、フォルダが...
-
META-INFフォルダの置き場所に...
-
デスクトップの画像をhtmlに表...
-
エクセル VBA ファイルをフォ...
-
ファイル名と同名のフォルダを...
-
VBA:特定の文字を含むフォルダ...
-
サーバ内のフォルダ名と各フォ...
-
VBA フォルダ名に特定の文字を...
-
エクセルのデータをメモ帳に貼...
-
フォルダ配下のファイル作成日...
-
Excel VBA 同じ名前のフォルダ...
-
保存先のフォルダ名を指定した...
-
GetAttrが原因?
-
VBA 最新のフォルダ取得
-
自動的に作られるresource.hに...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Windows10でコマンドプロンプト...
-
パス名に2バイト文字(マルチバ...
-
ファイル名と同名のフォルダを...
-
VBA 最新のフォルダ取得
-
Excelのハイパーリンクについて...
-
デスクトップの画像をhtmlに表...
-
ディレクトリ名変更してコピー...
-
VBA フォルダ名に特定の文字を...
-
バッチファイルで指定フォルダ...
-
フォルダ内のPDFファイル名を変...
-
Access VBA で フォルダ権限...
-
excelマクロ 冒頭3文字が一致す...
-
【マクロ】ファイル名の日付に...
-
フォルダにリンクを貼りたい
-
会社のネットワーク上のファイ...
-
多量のファイルをフォルダに自...
-
C ファイル出力で、フォルダが...
-
保存先のフォルダ名を指定した...
-
vbsで選択ダイアログを表示した...
-
Excel VBA 同じ名前のフォルダ...
おすすめ情報