VBAでファイルを自動分けがしたいですが・・・

１つのフォルダに100個くらいのファイルがあって、２G以内のファイルをひとまとりにしてそれぞれに新規フォルダに移動し、最終的にそれぞれのフォルダを指定して圧縮するVBAを書きたいですが、VBA初心者でまず、ファイルの仕分け処理で頭の中が混乱してきました。

可変の2次元配列にファイルを格納してから、フォルダに移動したほうがいいですかね？

先輩たちのご指導を宜しくお願いします。

VBA
1 Sub GetFileCount()
2    Dim col, gol_col As Collection
3    Set col = New Collection
4    'Set gol_col = New Collection
5    Dim savePath As String
6    savePath = Range("B2").Value
7
8    Dim dicList As Object
9    Set dicList = CreateObject("Scripting.Dictionary")
10    Dim gl_dicList As Object
11    Set gl_dicList = CreateObject("Scripting.Dictionary")
12    Dim gl_cnt As Integer
13    
14    Dim MAXSize, MAX2GSize As Currency
15    MAXSize = 2147483648#  'ファイルサイズ2G最大値
16    'Debug.Print (MAXSize)
17    
18    'ファイル数を知りたいフォルダのパス
19    Dim folderPath As String
20    folderPath = Range("B1").Value
21    
22    'ファイルシステムオブジェクト
23    Dim FSO As Object
24    Set FSO = CreateObject("Scripting.FileSystemObject")
25    
26    Dim fl As Folder
27    Set fl = FSO.GetFolder(folderPath) ' フォルダを取得
28    Dim s, addfiname As String
29    Dim f As file
30    Dim a As Long
31    Dim bSize As Currency
32    Dim count As Integer
33    Dim a_sFolder As String
34    a_sFolder = "ファイルパス" & "\" & Format(Date, "yyyymmdd")
35    
36    For Each f In fl.files ' フォルダ内のファイルを取得
37        s = f.Path      ' パスを取得
38        'Debug.Print (s) ' D:\TipsFolder\Tips.txt など
39        Dim iSize
40    
41        '// アクティブブックのファイルサイズを取得
42        'iSize = FileLen(s)
43        iSize = FSO.GetFile(s).Size
44        bSize = CCur(bSize) + CCur(iSize)
45        If (CCur(bSize) <= MAXSize) Then
46        
47            'If Dir(a_sFolder, vbDirectory) = "" Then
48                'MkDir a_sFolder
49            'End If
50            'Call FSO.MoveFile(s, a_sFolder & "\")
51            count = count + 1
52            addfiname = addfiname & FSO.GetFile(s).Name & " "
53            addfiname = addfiname & s & " "
54            'col.Add s
55            dicList.Add "key" & CStr(count), s
56            Debug.Print (dicList.Item("key" & CStr(count)))
57        Else
58            gl_dicList.Add CStr(gl_cnt), dicList
59            MsgBox gl_dicList(CStr(gl_cnt))("key1")
60            'Debug.Print CStr(gl_cnt)
61            'Debug.Print gl_dicList(CStr(gl_cnt))
62            gl_cnt = gl_cnt + 1
63            dicList.RemoveAll
64            'col = New Collection
65            count = count + 1
66            bSize = 0
67            bSize = CCur(bSize) + CCur(iSize)
68            If (CCur(bSize) <= MAXSize) Then
69        
70                'If Dir(a_sFolder, vbDirectory) = "" Then
71                    'MkDir a_sFolder
72                'End If
73                'Call FSO.MoveFile(s, a_sFolder & "\")
74                addfiname = addfiname & FSO.GetFile(s).Name & " "
75                addfiname = addfiname & s & " "
76                'col.Add s
77                dicList.Add "key" & CStr(count), s
78                Debug.Print (dicList.Item("key" & CStr(count)))
79            End If
80            
81            '圧縮処理
82            'a_sFolder = a_sFolder & "_" & count
83            
84            'savePath = savePath & "\" & count & ".zip"
85            'Debug.Print (savePath)
86            'CompressArchive_cmd a_sFolder, savePath, count
87            'Call FSO.MoveFile(a_sFolder & "*", "移動先パス")
88            'CompressArchive col, savePath
89            'FileArchive str
90            'End
91        End If
92        'Debug.Print (str)
93        'Debug.Print (bSize)
94        
95        'dicList.Add s, iSize
96        'bSize = bSize + iSize
97        'Debug.Print "---bSize = " & bSize
98        'If (CLng(bSize) <= MAXSize) Then
99            'count = count + 1
100        'End If
101    Next
102    
103    'ループ用の変数
104    'Dim i, j As Integer
105    'Dim keys
106    'Dim items
107    
108    'keys = dicList.keys
109    'items = dicList.items
110    'j = 0
111    'For i = 0 To dicList.count - 1
112        'bSize = bSize + items(i)
113        'If (CLng(bSize) <= MAXSize) Then
114        
115        'Else
116            'bSize = bSize - items(i)
117            'j = i - 1
118        'End If
119        'Debug.Print "ファイル名：" & keys(i) & "、ファイルサイズ：" & items(i)
120    'Next i
121    
122    ' 後始末
123    Set FSO = Nothing
124    
125    'ファイル数を格納する変数
126    'Dim j As Long
127    'j = fso.GetFolder(folderPath).files.count
128    'Debug.Print "ファイルCount = " & j
129End Sub

100個ファイルのファイル名は関係なく、サイズのみ取得して、合計サイズが２Gだったら「yyyyddmm」フォルダ(任意)に移動し、次のファイルからまた合計が２Gだったら「yyyyddmm_1」フォルダ(任意)に移動していって、全ファイルを２Gサイズのまとまりをフォルダ分けして移動したいです。
フォルダ分けでなくても、2次元配列の1行目に２G単位の全ファイル名（例えば1個目～9個目ファイルが２G）が格納され、2行目にも（10個目～18個目ファイルが２G）ファイル名が格納されてもいいです。

宜しくお願いします。

行動規範の内容に同意します

回答3件

補足要求です。
１．マクロ全部をアップしていただけませんでしょうか。
特に、CCur,MAXSize,a_sFolderの定義、及び初期値がどうなっているのかがよくわかりません。
２．ファイルをまとめるとき、ファイル名は関係なく、ファイルサイズのみ考慮するのでしょうか。
３．「２G以内のファイルをひとまとりにして」の意味がよくわかりません。
以下のような解釈であってますか。
（１）各ファイルのサイズの合計値が２G以内の範囲でまとめ続ける。
（２）もし２Gを超えた場合は、そのファイルを次のひとまとまりにまわし、今までのぶん
のひとまとまりを新規フォルダに格納する。
（３）１つのファイルのサイズが２Gを超えている場合は、そのファイルのみを
ひとまとまりとして扱う。
４．新規フォルダは、現在処理中のフォルダの下に作るのですか。
そのフォルダ名は、どのようになっていますか。
１番目のフォルダ名
２番目のフォルダ名
３番目のフォルダ名
・・・以下同様・・・

投稿2021/01/05 02:38

tatsu99

総合スコア5493

rena_168

2021/01/05 03:37

VBAコードが汚くて、恥ずかしいですが、一応載せました。おっしゃる通りです！それぞれフォルダへの移動はあくまで２G単位でファイルを束ねたいからであって、もし2次元配列だったらフォルダ移動なんて必要ないかと思いました。 VBAの2次元配列の書き方は特殊のようですが、ご指導をお願いします。

rena_168

2021/01/05 07:34

すみません、ソースを修正してみました。ファイルサイズが２G超えたら、親Dictionaryにまとまった子Dictionaryを格納してみました。なかなか用量が悪くて苦労してますが、ちょっと一歩前に進んだ気がしますが、ご指導をお願いします。

行動規範の内容に同意します

ArrayListを使った方法です。
gl_dicList の値の部分をDictionaryでなく、ArrayListにしてパス名をリスト形式にして保持しています。
こちらの方が多少簡単かと。

VBA
1Sub GetFileCount2()
2    Dim col, gol_col As Collection
3    Set col = New Collection
4    'Set gol_col = New Collection
5    Dim savePath As String
6    savePath = Range("B2").value
7
8    Dim ArrList As Object
9    Dim gl_dicList As Object
10    Set gl_dicList = CreateObject("Scripting.Dictionary")
11    Dim gl_cnt As Integer
12    Dim key As Variant
13    Dim i As Long
14    
15    Dim MAXSize, MAX2GSize As Currency
16    MAXSize = 2147483648#  'ファイルサイズ2G最大値
17    'Debug.Print (MAXSize)
18
19    'ファイル数を知りたいフォルダのパス
20    Dim folderPath As String
21    folderPath = Range("B1").value
22
23    'ファイルシステムオブジェクト
24    Dim FSO As Object
25    Set FSO = CreateObject("Scripting.FileSystemObject")
26
27    Dim fl As Folder
28    Set fl = FSO.GetFolder(folderPath)    ' フォルダを取得
29    Dim s, addfiname As String
30    Dim f As File
31    Dim a As Long
32    Dim bSize As Currency
33    Dim count As Integer
34    Dim a_sFolder As String
35    a_sFolder = "ファイルパス" & "\" & Format(Date, "yyyymmdd")
36    count = 0
37    bSize = 0
38    For Each f In fl.Files    ' フォルダ内のファイルを取得
39        s = f.Path      ' パスを取得
40        'Debug.Print (s) ' D:\TipsFolder\Tips.txt など
41        Dim iSize
42        count = count + 1
43        '// アクティブブックのファイルサイズを取得
44        'iSize = FileLen(s)
45        iSize = FSO.GetFile(s).Size
46        If CCur(bSize) + CCur(iSize) > MAXSize Or count = 1 Then
47            gl_cnt = gl_cnt + 1
48            Set ArrList = CreateObject("System.Collections.ArrayList")     '.NET Frameworkへの参照
49            gl_dicList.Add CStr(gl_cnt), ArrList
50            bSize = 0
51        End If
52        bSize = CCur(bSize) + CCur(iSize)
53        gl_dicList(CStr(gl_cnt)).Add s
54    Next
55    '内容の印字
56    For Each key In gl_dicList
57        Debug.Print "key=", key
58        For i = 0 To gl_dicList(key).count - 1
59            Debug.Print "i=", i, "path=", gl_dicList(key)(i)
60        Next
61    Next
62End Sub
63
64

投稿2021/01/05 11:18

tatsu99

総合スコア5493

ベストアンサー

各Dictionaryですが、以下の認識であってますか。
gl_dicListのキーと値
キー：１からの連番
値：dicList

dicListのキーと値
キー："key"＋ファイルの連番
値：ファイルのフルパス名

gl_dicListのキーは２Gのかたまり単位で増加する。
それで良いなら、以下のようになります。

VBA
1Sub GetFileCount()
2    Dim col, gol_col As Collection
3    Set col = New Collection
4    'Set gol_col = New Collection
5    Dim savePath As String
6    savePath = Range("B2").value
7
8    Dim dicList As Object
9    Set dicList = CreateObject("Scripting.Dictionary")
10    Dim gl_dicList As Object
11    Set gl_dicList = CreateObject("Scripting.Dictionary")
12    Dim gl_cnt As Integer
13    Dim key1 As Variant
14    Dim key2 As Variant
15    
16    Dim MAXSize, MAX2GSize As Currency
17    MAXSize = 2147483648#  'ファイルサイズ2G最大値
18    'Debug.Print (MAXSize)
19
20    'ファイル数を知りたいフォルダのパス
21    Dim folderPath As String
22    folderPath = Range("B1").value
23
24    'ファイルシステムオブジェクト
25    Dim FSO As Object
26    Set FSO = CreateObject("Scripting.FileSystemObject")
27
28    Dim fl As Folder
29    Set fl = FSO.GetFolder(folderPath)    ' フォルダを取得
30    Dim s, addfiname As String
31    Dim f As File
32    Dim a As Long
33    Dim bSize As Currency
34    Dim count As Integer
35    Dim a_sFolder As String
36    a_sFolder = "ファイルパス" & "\" & Format(Date, "yyyymmdd")
37    count = 0
38    bSize = 0
39    For Each f In fl.Files    ' フォルダ内のファイルを取得
40        s = f.Path      ' パスを取得
41        'Debug.Print (s) ' D:\TipsFolder\Tips.txt など
42        Dim iSize
43        count = count + 1
44        '// アクティブブックのファイルサイズを取得
45        'iSize = FileLen(s)
46        iSize = FSO.GetFile(s).Size
47        If CCur(bSize) + CCur(iSize) > MAXSize Or count = 1 Then
48            gl_cnt = gl_cnt + 1
49            Set dicList = CreateObject("Scripting.Dictionary")
50            gl_dicList.Add CStr(gl_cnt), dicList
51            bSize = 0
52        End If
53        bSize = CCur(bSize) + CCur(iSize)
54        gl_dicList(CStr(gl_cnt)).Add "key" & CStr(count), s
55    Next
56    '内容の印字
57    For Each key1 In gl_dicList
58        Set dicList = gl_dicList(key1)
59        Debug.Print "key1=", key1
60        For Each key2 In dicList
61            Debug.Print "key2=", key2, "path=", dicList(key2)
62        Next
63    Next
64End Sub
65

投稿2021/01/05 09:04

tatsu99

総合スコア5493

rena_168

2021/01/06 05:42

すみません、If文にcount = 1があると、初回はIf文に入り、gl_dicList.Add CStr(gl_cnt), dicListのdicListは空だと思いますが、どうですかね？２Gのファイルがひとまとまりになったら、dicListの中身をgl_dicListに格納してから、dicListの中身をクリアにしなくて大丈夫でしょうか？

tatsu99

2021/01/06 05:58

はい。空のdicListを作り、そのあとで gl_dicList(CStr(gl_cnt)).Add "key" & CStr(count), s で、dicListに登録しています。つまり、最初の１件目、もしくは、ファイルの合計サイズが２Gを超える場合のみ、 gl_dicListに新たなキーを作成し、空のdicListを作成します。 gl_dicListに新たなキーを作成するということは、その前までのキーの分は、既にgl_dicListに格納されているということです。このマクロを実際に動かしても、ファイルの移動は行われません。一覧が表示されるだけです。実際に動かして、望んだ結果になることを確認してください。

rena_168

2021/01/06 07:46

動作確認しました。とても綺麗ですっきりした書き方で、参考になりました。私の整理できていない書き方はとても見にくいと実感しました。 dicList.AddがないのにちゃんとdicListに追加されたことが不思議に思いました。

tatsu99

2021/01/06 07:59

gl_dicList(CStr(gl_cnt)).Add "key" & CStr(count), s が dicList.Addの個所に相当します。上記を Set dicList = gl_dicList(CStr(gl_cnt)) dicList.Add "key" & CStr(count), s に変えても同じ結果が得られます。 gl_dicList(CStr(gl_cnt)).Add "key" & CStr(count), s はそれを1行で行ってるだけです。

rena_168

2021/01/08 02:17

返事が遅くなって、すみません。私はそのようなスマートなコードが書けないし、一瞬みてても理解するのに時間がかかったのでレベルがかなり違うなと思いました。頭で思ったことが正しくても、どんな言語であっても結局コードで表せれなかったら意味ないですもんね。色々とありがとうございます！

行動規範の内容に同意します

あなたの回答