
多量のファイルをフォルダに自動振り分けするマクロを教えて下さい。
エクセル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で質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ファイル名と同名のフォルダを...
-
Excelのハイパーリンクについて...
-
会社のネットワーク上のファイ...
-
バッチファイルで指定フォルダ...
-
エクセル マクロで指定フォル...
-
フォルダにリンクを貼りたい
-
パス名に2バイト文字(マルチバ...
-
ファイルとフォルダのどちらも...
-
VBA フォルダの複数選択ができない
-
ExcelのVBAでフォルダ指定がで...
-
条件に合うフォルダが存在する...
-
【ExcelVBA】一覧表の記載に従...
-
[VBS] Unicodeの文字化けを防ぎ...
-
フォルダ名に番号を連番でつけたい
-
多量のファイルをフォルダに自...
-
エクセルのマクロについて質問...
-
VBAでファイル名を指定して保存...
-
Excel VBA マクロ フォルダ名を...
-
Downloaded Program Filesはど...
-
【マクロ】フォルダにファイル...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Windows10でコマンドプロンプト...
-
VBA 最新のフォルダ取得
-
デスクトップの画像をhtmlに表...
-
ファイル名と同名のフォルダを...
-
会社のネットワーク上のファイ...
-
ExcelのVBAでフォルダ指定がで...
-
Excelで指定したフォルダに保存...
-
VBA フォルダの複数選択ができない
-
【マクロ】ファイル名の日付に...
-
VB.NRT FolderBrowserDialogを...
-
【マクロ】フォルダにファイル...
-
ThisWorkbookがあるフォルダ更...
-
ディレクトリ名変更してコピー...
-
(C#)フォルダを指定するダイ...
-
VB6で7-ZIPのAPIを使用した圧縮...
-
VBプロジェクトでのフォルダ構...
-
パス名に2バイト文字(マルチバ...
-
Debug フォルダは消していいの?
-
フォルダにリンクを貼りたい
-
フォルダAから1つのファイルだ...
おすすめ情報