Question

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

示例：

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

我想在所有文件夹abc，xyz，tyu，ijk..etc
然后将每个文件夹abc，xyz，tyu，ijk中的所有文件“jpg”移动到刚创建的每个文件夹的“ABC”文件夹中
检查每个文件夹，查看文件夹“ABC”是否为空，是否为空

strFolder = "/"   '<== This place how to automatically create a folder "ABC"
                  '    in the directory available

SET objFSO = CREATEOBJECT("Scripting.FileSystemObject")

'Move file jpg    '<== I do not get it

IF objFSO.FolderExists(strFolder) = FALSE THEN
  objFSO.CreateFolder strFolder
  wscript.echo "Folder Created"
ELSE
  wscript.echo "Folder already exists"
END IF

Answer 1

回答作为答案写的问题......

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函数更好，因为它不会处理覆盖现有文件。

总结...在当前目录中的每个子文件夹上，查看子文件夹\ big是否存在。如果是，则回显文本，否则创建文件夹和回显文本。然后，对于该子文件夹中的每个文件，将其移动到子文件夹\ big文件夹，覆盖现有文件，如果复制成功，则删除源文件。您可以在移动之前添加内容以检查扩展（仅定位某些文件类型），如果文件已存在则退出sub（不覆盖现有文件）。

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

1 个答案: