需要帮助使用 VBS 移动和重命名文件

Question

我正在编写一个脚本，我需要执行以下操作： 在工作文件夹中，我有一个这样的文件夹结构：

• 一个
  • 1
  • 2
• 乙
  • 1
  • 2

根文件夹中有文件需要根据文件名移动到这些文件夹中。文件名示例为“A, 1~ 1001-Text”。我拥有的脚本（如下）当前会将这个文件移动到文件夹“A”中，并将文件重命名为“1~ 1001-Text”，使用逗号作为分隔符。

Dim fso
Dim CurrentFolder
Dim Files
Dim NewFolderName
Dim TruncatedFileName
Dim NewFileName
Dim aString
Dim Array

Set fso = CreateObject("Scripting.FileSystemObject")
Set CurrentFolder = fso.GetFolder(".")
Set Files = CurrentFolder.Files

For Each File in Files
   If UCase(Right(File.Name,3)) <> "VBS" Then
  TruncatedFileName = Left(File.Name, InstrRev(File.Name, ", ") - 1)
    aString = File.Name
    Array = Split(aString,", ")
    NewFileName = Trim(Array(1))
  File.Move TruncatedFileName & "\"
  fso.MoveFile TruncatedFileName & "\" & File.Name, TruncatedFileName & "\" & NewFileName
   End If
Next

我需要的是代码然后将文件夹“A”中的文件“1~ 1001-Text”移动到子文件夹“1”中，然后重命名文件“1001-Text”，使用“~”作为分隔符。 我已经尝试为每个变量创建 2 个，并在 For Next 语句中复制代码，但这不起作用......有什么建议吗？提前致谢。

Answer 1

我认为你需要这样的东西....（未测试）

Dim fso
Dim CurrentFolder
Dim Files
Dim Array1
Dim Array2

Set fso = CreateObject("Scripting.FileSystemObject")
Set CurrentFolder = fso.GetFolder(".")
Set Files = CurrentFolder.Files

For Each File in Files


If UCase(Right(File.Name,3)) <> "VBS" Then 'only do non .vbs files

    Array1 = Split(File.Name, ", ") ' split the filename based on the ,

    If (Len(Array1(0)) = 1) Then ' if the first part was a value single character (folder name) 

        Array2 = Split(Array1(1), "~ ") ' now split the second part of the filename

        If (Len(Array2(0)) = 1) And (IsNumeric(Array2(0))) Then ' if it had a valid single number value numeric folder name

            fso.MoveFile(File, Trim(Array1(0)) & "\" & Trim(Array2(0)) & "\" & Trim(Array2(1))) ' do the move

        Else

            MsgBox("Could not parse '~ ' from file '" & File.Name & "'")

        End If

    Else

        MsgBox("Could not parse ', ' from file '" & File.Name & "'")

    End If

End If

Next

Set CurrentFolder = Nothing
Set Files = Nothing
Set fso = Nothing