' EasyFolder 1.1.1 - 08/02/21
' Copyright (C) 2008 Y.Kumagai, ClockRoom Software

' ひとつ、または、複数のファイルを指定のルールで移動。
'
' wscript this.vbs /dest:基本パス /name:フォルダ名 ファイル名 [ファイル名...]
'
' 詳細を書こうと思いましたが面倒くさくなりました(ぉ
' 勝手に解読しやがってください。
'
' ファイル数に制限があります。制限を超えると「アクセスできま
' せん」などのエラーが表示されます。回避策としてファイル名の
' 代わりに親フォルダを指定することも出来ます。

'***********************************************************

Option Explicit

'***********************************************************

Dim comShell : Set comShell=WScript.CreateObject("WScript.Shell")
Dim comApp : Set comApp=WScript.CreateObject("Shell.Application")
Dim comFSO : Set comFSO=WScript.CreateObject("Scripting.FileSystemObject")

'***********************************************************

Main

'***********************************************************

Sub Main()

	Dim sDest,sName,aSrc
	Dim path,folder,src

	If Not GetArguments(sDest,sName,aSrc) Then Exit Sub

	path=CreateFolder(sDest,sName)
	Set folder=comApp.NameSpace(path)

	For Each src In aSrc
		If comFSO.FileExists(src) Then
			folder.MoveHere src
		Else
			folder.MoveHere comFSO.BuildPath(src,"*")
		End If
	Next

	comShell.Run """" & path & """"

End Sub

'***********************************************************

Function GetArguments(ByRef rsDest,ByRef rsName,ByRef raSrc)

	Dim src

	rsDest=WScript.Arguments.Named("dest")
	rsName=WScript.Arguments.Named("name")
	Set raSrc=WScript.Arguments.Unnamed

	GetArguments=True

	If Not comFSO.FolderExists(rsDest) Then
		MsgBox "基本パスが存在しません。"
		GetArguments=False
	End If

	If InStr(rsName,"\N")=0 Then
		MsgBox "フォルダ名に""\N""がありません。"
		GetArguments=False
	End If

	If raSrc.Count=0 Then
		MsgBox "パラメータにファイル名がありません。"
		GetArguments=False
	End If

	For Each src In raSrc
		If Not comFSO.FileExists(src) And _
			Not comFSO.FolderExists(src) Then
			MsgBox "ファイルが存在しません。"
			GetArguments=False
			Exit For
		End If
	Next

End Function

'***********************************************************

Function CreateFolder(ByVal dest,ByVal name)

	Dim i : i=1

	Do
		CreateFolder=comFSO.BuildPath(dest,FormatFolderName(name,i))
		i=i+1
	Loop While comFSO.FolderExists(CreateFolder)

	comFSO.CreateFolder CreateFolder
	CreateFolder=comFSO.GetFolder(CreateFolder).Path

End Function

'***********************************************************

Function FormatFolderName(ByVal name,ByVal no)

	Dim s : s=name
	Dim c

	If no=1 And InStr(s,"<")>0 And InStr(s,">")>0 Then
		s=Left(s,InStr(s,"<")-1) & Mid(s,InStr(s,">")+1)
	End If

	s=Replace(s,"\YY",Right(Year(Now),2))
	s=Replace(s,"\MM",Right("0" & Month(Now),2))
	s=Replace(s,"\DD",Right("0" & Day(Now),2))
	s=Replace(s,"\Y",Year(Now))
	s=Replace(s,"\M",Month(Now))
	s=Replace(s,"\D",Day(Now))
	s=Replace(s,"\N",no)

	For Each c In Array("\","/",":","*","?","""","<",">","|")
		s=Replace(s,c,"")
	Next

	FormatFolderName=s

End Function

'***********************************************************