大量のファイルを指定サイズ毎にまとめて分割するスクリプト

Tweet

はじめに

大量のファイルを「指定のサイズ毎」にまとめて振り分けたい！

と思ったことはありませんか？

前々からYahooショッピングへ商品登録を行う際に「手作業で画像サイズを確認しながら圧縮するのが面倒だな－」と思っていたんです。「ファイル サイズ 振り分け 方法」等々の単語で色々検索を掛けてはみるんですが、どうにも目的のツールがヒットしない・・・

※Yahooショッピングでは一度にアップロードできる画像サイズが決まっており、25MBが上限となっています。

きっとどこかに存在はしているんでしょうけど、どこにあるのか見つけられなかったので自分で作りました。

以下ソースコード

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'==========================================================
'　画像を一定のサイズ毎にフォルダに振り分ける
'==========================================================
Public Sub partedFilesBySize()
    Dim objFile As Object
    Dim File_List As Variant
    Dim lFileSize As Long
    Dim lTotalSize As Long
    Dim lLimitSize As Long
    Dim sTargetFolderPath As String
    Dim sSaveFolderPath As String
    Dim sSavePath As String
    Dim iFolderCnt As Integer
    Dim sBuf As String
    
    '   実行結果の表示
    Dim lCnt As Long
    Dim lMax As Long
    
    sTargetFolderPath = InputBox("振り分け元のフォルダパスを入力して下さい")
    lLimitSize = InputBox("上限とするサイズを入力して下さい（単位：Mbyte）") * 1000000
    
    If sTargetFolderPath <> "" And lLimitSize > 0 Then
        MsgBox "処理を開始致します。" & vbCrLf & _
               "処理済みのデータはデスクトップ上に保存されます。"
        
        sSaveFolderPath = createFolder(CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & "\processed_img")
        iFolderCnt = 1
        lCnt = 1
        
        With CreateObject("Scripting.FileSystemObject")
            lMax = .GetFolder(sTargetFolderPath).Files.Count
            
            For Each objFile In .GetFolder(sTargetFolderPath).Files
                Application.StatusBar = lCnt & " / " & lMax & " 件 処理済み"
                sBuf = objFile.name
                '   ファイルサイズを取得
                lFileSize = FileLen(sTargetFolderPath & "\" & sBuf)
                
                
                '   以下のいずれかの条件に一致する場合に保存先フォルダを作成する
                '   1 : lTotalSize（合計サイズ）の内容が0（ループ開始時）の場合
                '   2 : 合計サイズ + 次ファイルの容量が設定上限を超える場合
                If lTotalSize = 0 Or (lTotalSize + lFileSize) > lLimitSize Then
                
                    sSavePath = createFolder(sSaveFolderPath & "\" & Format(iFolderCnt, "0000"))
                    lTotalSize = lFileSize
                    iFolderCnt = iFolderCnt + 1
                
                Else
                
                    lTotalSize = lTotalSize + lFileSize
                
                End If
                
                '   ファイルコピー
                FileCopy sTargetFolderPath & "\" & sBuf, sSavePath & "\" & sBuf
                
                lCnt = lCnt + 1
                DoEvents
                Sleep 1
            Next
        End With
        
    End If
    
    MsgBox "サイズ振り分けが完了しました！"
End Sub

'==========================================================
'　フォルダ生成
'　対象のフォルダが既に存在する場合は何もしない
'==========================================================
Public Function createFolder(path As String) As String

    If Dir(path, vbDirectory) = "" Then
        MkDir path
    End If
    
    createFolder = path
End Function

機能説明

partedFilesBySizeを実行すると元データの格納されているフォルダパスを聞かれるので、
「C:\Users\hoge\Desktop\img」の様な形で入力して下さい。フォルダ開いてアドレスバーのコピペで大丈夫です。

次にどの位のサイズ毎に振り分けるかを聞かれるので、メガバイト単位で数値を入力して下さい。20MBずつに分けたい場合は「20」と入力するだけでOKです。少数で入力しても問題ありませんが、1バイト未満になる様な入力桁はカットされます。

処理中はエクセルのステータスバー（左下部分）に以下の表示を行いますので、処理件数と残件数が一目で分かる様になっています。

振り分け後のファイルは自動的にデスクトップに保存される様になっています。

「processed_img」というフォルダが作られていますので、中身を確認して見て下さい。

この様な形でフォルダが自動生成されていきます。ちなみにファイルはコピーしているので、元ファイルはそのまま残っています。

今の所自動圧縮機能は付けていないので、各フォルダを開いて手動で圧縮する必要があります。

デスクトップのパスを自動指定するあたりが恐らく環境によってうまく動かないことがあります。（作成環境OS：Windows7）その場合は27行目の

sSaveFolderPath = createFolder(CreateObject("WScript.Shell").SpecialFolders.Item("Desktop") & "\processed_img")

createFolder（）内の部分に直接デスクトップのパスを入力するなどして書き換えて下さい。

もう少し改良すればヤフオクストアにも応用できそうですね。ヤフオクストアのアップロード方法ってほんっっっっっっっとうに面倒臭いんですけど、何とかならないんですかね－・・・。

せめてYahooショッピングと同じ様な仕様にしてくれれば・・・。

忙しい人向け：VBSダウンロード

エクセルに組み込む予定は無いしわざわざ作るのも面倒という方向けにスクリプトファイルも用意してみましたので、以下からどうぞ。（処理の進捗を表示する機能は消えています）

ファイル自動振り分けスクリプト

1 file(s) 1.18 KB

ダウンロードはこちら！

zip解凍後、ファイル名の後ろにあるアンダースコア「_」を削除して使用して下さい。