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

Question

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

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

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

 Sub GetFileCount()
    Dim col, gol_col As Collection
    Set col = New Collection
    'Set gol_col = New Collection
    Dim savePath As String
    savePath = Range("B2").Value

    Dim dicList As Object
    Set dicList = CreateObject("Scripting.Dictionary")
    Dim gl_dicList As Object
    Set gl_dicList = CreateObject("Scripting.Dictionary")
    Dim gl_cnt As Integer
    
    Dim MAXSize, MAX2GSize As Currency
    MAXSize = 2147483648#  'ファイルサイズ2G最大値
    'Debug.Print (MAXSize)
    
    'ファイル数を知りたいフォルダのパス
    Dim folderPath As String
    folderPath = Range("B1").Value
    
    'ファイルシステムオブジェクト
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Dim fl As Folder
    Set fl = FSO.GetFolder(folderPath) ' フォルダを取得
    Dim s, addfiname As String
    Dim f As file
    Dim a As Long
    Dim bSize As Currency
    Dim count As Integer
    Dim a_sFolder As String
    a_sFolder = "ファイルパス" & "\" & Format(Date, "yyyymmdd")
    
    For Each f In fl.files ' フォルダ内のファイルを取得
        s = f.Path      ' パスを取得
        'Debug.Print (s) ' D:\TipsFolder\Tips.txt など
        Dim iSize
    
        '// アクティブブックのファイルサイズを取得
        'iSize = FileLen(s)
        iSize = FSO.GetFile(s).Size
        bSize = CCur(bSize) + CCur(iSize)
        If (CCur(bSize) <= MAXSize) Then
        
            'If Dir(a_sFolder, vbDirectory) = "" Then
                'MkDir a_sFolder
            'End If
            'Call FSO.MoveFile(s, a_sFolder & "\")
            count = count + 1
            addfiname = addfiname & FSO.GetFile(s).Name & " "
            addfiname = addfiname & s & " "
            'col.Add s
            dicList.Add "key" & CStr(count), s
            Debug.Print (dicList.Item("key" & CStr(count)))
        Else
            gl_dicList.Add CStr(gl_cnt), dicList
            MsgBox gl_dicList(CStr(gl_cnt))("key1")
            'Debug.Print CStr(gl_cnt)
            'Debug.Print gl_dicList(CStr(gl_cnt))
            gl_cnt = gl_cnt + 1
            dicList.RemoveAll
            'col = New Collection
            count = count + 1
            bSize = 0
            bSize = CCur(bSize) + CCur(iSize)
            If (CCur(bSize) <= MAXSize) Then
        
                'If Dir(a_sFolder, vbDirectory) = "" Then
                    'MkDir a_sFolder
                'End If
                'Call FSO.MoveFile(s, a_sFolder & "\")
                addfiname = addfiname & FSO.GetFile(s).Name & " "
                addfiname = addfiname & s & " "
                'col.Add s
                dicList.Add "key" & CStr(count), s
                Debug.Print (dicList.Item("key" & CStr(count)))
            End If
            
            '圧縮処理
            'a_sFolder = a_sFolder & "_" & count
            
            'savePath = savePath & "\" & count & ".zip"
            'Debug.Print (savePath)
            'CompressArchive_cmd a_sFolder, savePath, count
            'Call FSO.MoveFile(a_sFolder & "*", "移動先パス")
            'CompressArchive col, savePath
            'FileArchive str
            'End
        End If
        'Debug.Print (str)
        'Debug.Print (bSize)
        
        'dicList.Add s, iSize
        'bSize = bSize + iSize
        'Debug.Print "---bSize = " & bSize
        'If (CLng(bSize) <= MAXSize) Then
            'count = count + 1
        'End If
    Next
    
    'ループ用の変数
    'Dim i, j As Integer
    'Dim keys
    'Dim items
    
    'keys = dicList.keys
    'items = dicList.items
    'j = 0
    'For i = 0 To dicList.count - 1
        'bSize = bSize + items(i)
        'If (CLng(bSize) <= MAXSize) Then
        
        'Else
            'bSize = bSize - items(i)
            'j = i - 1
        'End If
        'Debug.Print "ファイル名：" & keys(i) & "、ファイルサイズ：" & items(i)
    'Next i
    
    ' 後始末
    Set FSO = Nothing
    
    'ファイル数を格納する変数
    'Dim j As Long
    'j = fso.GetFolder(folderPath).files.count
    'Debug.Print "ファイルCount = " & j
End Sub

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

宜しくお願いします。

Answer 1

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

Comments

[rena_168]

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

[rena_168]

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

Answer 2

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

Sub GetFileCount2()
    Dim col, gol_col As Collection
    Set col = New Collection
    'Set gol_col = New Collection
    Dim savePath As String
    savePath = Range("B2").value

    Dim ArrList As Object
    Dim gl_dicList As Object
    Set gl_dicList = CreateObject("Scripting.Dictionary")
    Dim gl_cnt As Integer
    Dim key As Variant
    Dim i As Long
    
    Dim MAXSize, MAX2GSize As Currency
    MAXSize = 2147483648#  'ファイルサイズ2G最大値
    'Debug.Print (MAXSize)

    'ファイル数を知りたいフォルダのパス
    Dim folderPath As String
    folderPath = Range("B1").value

    'ファイルシステムオブジェクト
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    Dim fl As Folder
    Set fl = FSO.GetFolder(folderPath)    ' フォルダを取得
    Dim s, addfiname As String
    Dim f As File
    Dim a As Long
    Dim bSize As Currency
    Dim count As Integer
    Dim a_sFolder As String
    a_sFolder = "ファイルパス" & "\" & Format(Date, "yyyymmdd")
    count = 0
    bSize = 0
    For Each f In fl.Files    ' フォルダ内のファイルを取得
        s = f.Path      ' パスを取得
        'Debug.Print (s) ' D:\TipsFolder\Tips.txt など
        Dim iSize
        count = count + 1
        '// アクティブブックのファイルサイズを取得
        'iSize = FileLen(s)
        iSize = FSO.GetFile(s).Size
        If CCur(bSize) + CCur(iSize) > MAXSize Or count = 1 Then
            gl_cnt = gl_cnt + 1
            Set ArrList = CreateObject("System.Collections.ArrayList")     '.NET Frameworkへの参照
            gl_dicList.Add CStr(gl_cnt), ArrList
            bSize = 0
        End If
        bSize = CCur(bSize) + CCur(iSize)
        gl_dicList(CStr(gl_cnt)).Add s
    Next
    '内容の印字
    For Each key In gl_dicList
        Debug.Print "key=", key
        For i = 0 To gl_dicList(key).count - 1
            Debug.Print "i=", i, "path=", gl_dicList(key)(i)
        Next
    Next
End Sub

Answer 3

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

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

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

Sub GetFileCount()
    Dim col, gol_col As Collection
    Set col = New Collection
    'Set gol_col = New Collection
    Dim savePath As String
    savePath = Range("B2").value

    Dim dicList As Object
    Set dicList = CreateObject("Scripting.Dictionary")
    Dim gl_dicList As Object
    Set gl_dicList = CreateObject("Scripting.Dictionary")
    Dim gl_cnt As Integer
    Dim key1 As Variant
    Dim key2 As Variant
    
    Dim MAXSize, MAX2GSize As Currency
    MAXSize = 2147483648#  'ファイルサイズ2G最大値
    'Debug.Print (MAXSize)

    'ファイル数を知りたいフォルダのパス
    Dim folderPath As String
    folderPath = Range("B1").value

    'ファイルシステムオブジェクト
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    Dim fl As Folder
    Set fl = FSO.GetFolder(folderPath)    ' フォルダを取得
    Dim s, addfiname As String
    Dim f As File
    Dim a As Long
    Dim bSize As Currency
    Dim count As Integer
    Dim a_sFolder As String
    a_sFolder = "ファイルパス" & "\" & Format(Date, "yyyymmdd")
    count = 0
    bSize = 0
    For Each f In fl.Files    ' フォルダ内のファイルを取得
        s = f.Path      ' パスを取得
        'Debug.Print (s) ' D:\TipsFolder\Tips.txt など
        Dim iSize
        count = count + 1
        '// アクティブブックのファイルサイズを取得
        'iSize = FileLen(s)
        iSize = FSO.GetFile(s).Size
        If CCur(bSize) + CCur(iSize) > MAXSize Or count = 1 Then
            gl_cnt = gl_cnt + 1
            Set dicList = CreateObject("Scripting.Dictionary")
            gl_dicList.Add CStr(gl_cnt), dicList
            bSize = 0
        End If
        bSize = CCur(bSize) + CCur(iSize)
        gl_dicList(CStr(gl_cnt)).Add "key" & CStr(count), s
    Next
    '内容の印字
    For Each key1 In gl_dicList
        Set dicList = gl_dicList(key1)
        Debug.Print "key1=", key1
        For Each key2 In dicList
            Debug.Print "key2=", key2, "path=", dicList(key2)
        Next
    Next
End Sub

Comments

[rena_168]

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

[tatsu99]

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

[rena_168]

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

[tatsu99]

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]

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