画像のサイズ分けのプログラムのエラー

Question

vbaで画像のサイズごとに振り分けるプログラムを作っているのですがエラーが出てしまいます
ご教授をお願いします

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("C:\Users\souko\Desktop\processed_img").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

Comments

[ttyp03]

エラーが出るとは？
コンパイルで？実行中に？実行できるけど思った通りにならない？
途中で止まるならどこで？
詳細に書かないとわかりません。

[BeatStar]

エラーが出るなら、メッセージぐらいは読みましょう。