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

Question

我工作的一个脚本，我需要做以下文件： 在工作文件夹我有一个文件夹结构是这样的：

• 一个
• 乙

有在根文件夹需要被移动到基于文件名这些文件夹中的文件。文件名的例子是“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的文本”，到子文件夹中的“1”移动它，并重新命名文件“1001-文本“，使用”〜“作为分隔符。 我已经尝试创建每个变量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