vbs创建目录，可循环创建父级目录

On error resume Next

'删除字符串最右边的字符chs
Function MyRTrim(src, chs)                  '删除字符串最右边的字符chs(可多个)
    Dim pos, sLeft
    src = Trim(src)
    pos = InStrRev(src, chs)                '查找最后一个字符chs
    if(pos > 0 and Len(Mid(src, pos+1)) = 0) Then
        sLeft = Left(src, pos - 1)          '去除最后一个chs
        MyRTrim = MyRTrim(sLeft, chs)       '去除尾部的chs
    else
        MyRTrim = src
    end if
End Function

'创建目录，如果父目录不存在，则创建：实现一次性创建所有父级目录
Sub MyCreateFolder(sPath)
    Dim fs
    set fs = CreateObject("Scripting.FileSystemObject")
    if(Len(sPath) > 0 And fs.FolderExists(sPath) = False) Then
        Dim pos, sLeft
        pos = InStrRev(sPath, "\")
        if(pos <> 0) Then
            sLeft = Left(sPath, pos - 1)
            MyCreateFolder sLeft            '先创建父目录
        end if
        fs.CreateFolder sPath               '再创建本目录
    end if
    set fs = Nothing
End Sub

Dim path
path = "E:\Program\VBScript\A1\A2\A3"
path = MyRTrim(path, "\")
MyCreateFolder path