多重フォルダ解消.vbs

Option Explicit
' 多重フォルダ解消
'
' 最上位フォルダから、フォルダ内がフォルダ一つでなくなるまで、階層を繰り上げる
'

Dim fso,argc, arg_dir,i,topfolder
If WScript.Arguments.Count = 0 Then
    WScript.Echo("usage: this.vbs <フォルダ>" & vbCrlf _
        & "       this.vbs <フォルダ> <フォルダ> <フォルダ>")
    WScript.Quit()
End If

Set fso = CreateObject("Scripting.FileSystemObject")

argc = WScript.Arguments.Unnamed.Count
For i = 0 to argc - 1
    arg_dir = WScript.Arguments.Unnamed(i)
    If fso.FolderExists(arg_dir) <> false Then
        If ( IsDriveLetter(arg_dir) ) Then
            WScript.Echo("ドライブ名は指定できません: """ & arg_dir & """")
        Else
            topfolder = GetTopFolder(arg_dir)
            If (0 <> StrComp(arg_dir, topfolder, vbTextCompare)) Then
                Dim tmp, f, deldir
                Dim post_dir
                Set post_dir = Nothing

                Set f  = fso.GetFolder(topfolder)
                For Each tmp In fso.GetFolder(arg_dir).SubFolders
                    Set deldir = tmp
                Next

                For Each tmp in f.SubFolders
                    If (fso.FolderExists( arg_dir & "\" & tmp.Name))  Then
                        tmp.Name = "_" & tmp.Name
                        fso.MoveFolder tmp.path, arg_dir & "\"
                        Set post_dir = fso.GetFolder(arg_dir & "\" & tmp.Name)
                    Else
                        fso.MoveFolder tmp.path, arg_dir & "\"
                    End If
                Next
                For Each tmp in f.Files
                    fso.MoveFile tmp.path, arg_dir & "\"
                Next
                If fso.FolderExists(deldir.Path) Then
                    fso.DeleteFolder deldir.Path, true
                End If
                If Not (post_dir Is Nothing) Then
                    post_dir.Name = Mid(post_dir.Name, 2)
                End If

                Set deldir = Nothing
                Set f = Nothing
                Set tmp = Nothing
                Set post_dir = Nothing
            End If
        End If
    End If
Next
Set fso = Nothing

Function IsAlpha(c)
    Dim x
    x = Asc(c)
    IsAlpha = CBool( (65<=x And x<=90) Or (97<=x And x<=122) )
End Function

Function IsDriveLetter(p)
    If ( ((3=Len(p)) And (":\"=Right(p,2)) And IsAlpha(Left(p,1))) _
            Or ((2=Len(p)) And (":"=Right(p,1)) And IsAlpha(Left(p,1))) ) Then
        IsDriveLetter = true
    Else
        IsDriveLetter = false
    End If
End Function

Function GetTopFolder(d)
    Dim tmp, f, dirs
    Set f = fso.GetFolder(d)
    Set dirs = f.SubFolders
    If (f.Files.Count = 0 And dirs.Count = 1) Then
        For Each tmp In dirs
            GetTopFolder = GetTopFolder(tmp.Path)
        Next
    Else
        GetTopFolder = d
    End If
End Function