Sub ボタン1_Click()
Dim Folder As String
Dim Size As Long
Dim Size2 As Long
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim Files
Dim F(50) As String
Dim i As Integer
Dim FoundCell As Range
'バッチ
Dim obj As WshShell
Dim btFile
'---------------------------本番かテストか---------------------------------
'バッチ本番
btFile = ""
'バッチテスト
'btFile = ""
'本番フォルダ
Folder = ""
'テストフォルダ
'Folder = ""
'----------------------------------------------------------------------------
'作業対象フォルダがあれば実行
If Dir(Folder , vbDirectory) <> "" Then
'必要フォルダがなければ作成
If Dir(Folder & "対象1", vbDirectory) = "" And Dir(Folder & "対象2", vbDirectory) = "" And Dir(Folder & "対象3", vbDirectory) = "" Then
MkDir Folder & "対象1"
MkDir Folder & "対象2"
MkDir Folder & "対象3"
End If
'----ファイルサイズを参照しフォルダ分け(手順No.6)----
'対象フォルダの全ファイルの合計サイズを参照
Size = fso.GetFolder(Folder & "対象").Size / 3
'対象ファイル洗い出し
i = 0
Set Files = fso.GetFolder(Folder & "対象").Files
For Each file In Files
F(i) = file
i = i + 1
Next file
i = 0
Size2 = 0
'職員(対象)1にコピー
Do While Size > Size2 And F(i) <> ""
FileCopy F(i), Folder & "対象1\"
Size2 = fso.GetFolder(Folder & "対象1").Size
i = i + 1
Loop
Size2 = 0
'職員(対象)2にコピー
Do While Size > Size2 And F(i) <> ""
FileCopy F(i), Folder & "対象2\" & Right(F(i), Len(F(i)) - InStr(F(i), "職員") + 1)
Size2 = fso.GetFolder(Folder & "対象2").Size
i = i + 1
Loop
'残りを職員(対象)3にコピー
Do While F(i) <> ""
FileCopy F(i), Folder & "対象3\"
i = i + 1
Loop
'バッチでCSV結合
Set obj = New WshShell
Call obj.Run(btFile, WaitOnReturn:=True)
'後片付け
Set fso = Nothing
Set obj = Nothing
'Set wsh = Nothing
'正常終了のログ表示
MsgBox ("正常終了しました。No.31から対応お願いします。")
Else
MsgBox (Folder & "に抽出元フォルダがありませんので終了します。")
End If
End Sub
コメント