Vbscript 我想在多个可用文件夹中创建一个文件夹

我想在多个可用文件夹中创建一个文件夹（通过VBScript）

例如：

我有多个文件夹：abc、xyz、ijk。。。等等

• 我想在所有文件夹ABC、xyz、tyu、ijk…等中创建一个名为“ABC”的文件夹
• 然后移动每个文件夹abc、xyz、tyu、ijk中的所有文件“jpg”。。放入刚刚创建的每个文件夹的“ABC”文件夹中
• 检查每个文件夹，查看文件夹是否为“ABC”，是否为空

---

---

strFolder=“/”要回答作为答案编写的问题

Dim fso, shl, curdir, folder, file, newfoldername, newfolderpath
Set fso = CreateObject("Scripting.FileSystemObject")
Set shl = CreateObject("WScript.Shell")
curdir = shl.CurrentDirectory
newfoldername  = "big"

For Each folder In fso.GetFolder(curdir).Subfolders
    newfolderpath = fso.BuildPath(folder.Path, newfoldername)
    If Not fso.FolderExists(newfolderpath) Then
        fso.CreateFolder newfolderpath
        WScript.Echo newfolderpath & " created"
    Else
        WScript.Echo newfolderpath & " already exists"
    End If
    For Each file In folder.Files
        MoveFile file.Path, newfolderpath
    Next
Next

Sub MoveFile(source, destination)
    On Error Resume Next
    fso.CopyFile source, destination & "\", True ' true = overwrite
    If Err Then
        WScript.Echo "Error copying " & source & " to " & destination & ": " & Err.Description
        WScript.Quit
    Else
        fso.DeleteFile source, True
    End If
    On Error GoTo 0
End Sub

MoveFile
子项作为常规移动，即复制文件，如果成功，则删除源文件。比使用内置的fso.MoveFile函数更好，因为它不会覆盖现有文件

总之。。。在当前目录中的每个子文件夹上，查看是否存在subfolder\big。如果是，则回显文本，否则创建文件夹并回显文本。然后，对于该子文件夹中的每个文件，将其移动到子文件夹\大文件夹，覆盖现有文件，如果复制成功，则删除源文件。您可以在移动之前添加内容以检查扩展名（仅针对某些文件类型），或者如果文件已经存在，则退出sub（不覆盖现有文件）。
您的问题不是问题。：）你有没有克服困难的具体问题？谢谢你提醒我！我已编辑，您能帮我吗？如何确定要在其中创建新子文件夹的文件夹？在移动“所有jpg文件”之前，它们位于何处？首先，感谢您的回复，很棒的算法！非常抱歉，我不知道该如何完成这项任务？
Dim fso, shl, curdir, folder, file, newfoldername, newfolderpath
Set fso = CreateObject("Scripting.FileSystemObject")
Set shl = CreateObject("WScript.Shell")
curdir = shl.CurrentDirectory
newfoldername  = "big"

For Each folder In fso.GetFolder(curdir).Subfolders
    newfolderpath = fso.BuildPath(folder.Path, newfoldername)
    If Not fso.FolderExists(newfolderpath) Then
        fso.CreateFolder newfolderpath
        WScript.Echo newfolderpath & " created"
    Else
        WScript.Echo newfolderpath & " already exists"
    End If
    For Each file In folder.Files
        MoveFile file.Path, newfolderpath
    Next
Next

Sub MoveFile(source, destination)
    On Error Resume Next
    fso.CopyFile source, destination & "\", True ' true = overwrite
    If Err Then
        WScript.Echo "Error copying " & source & " to " & destination & ": " & Err.Description
        WScript.Quit
    Else
        fso.DeleteFile source, True
    End If
    On Error GoTo 0
End Sub