Question

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

甲
- 1
- 2
乙
- 1
- 2

根文件夹中的文件需要根据文件名移动到这些文件夹中。文件名示例为＆＃34; A，1~1001-Text＆＃34;。我的脚本（如下所示）目前将此文件移动到文件夹＆＃34; A＆＃34;，并使用逗号作为分隔符重命名文件＆＃34; 1~1001-Text＆＃34 ;.

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

我需要的是代码然后获取文件＆＃34; 1~1001-Text＆＃34;在文件夹＆＃34; A＆＃34;中，将其移至子文件夹＆＃34; 1＆＃34;，并使用＆＃34;〜＆＃重命名文件＆＃34; 1001-Text＆＃34; 34;作为分隔符。我尝试创建每个变量的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

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

1 个答案: