Нужна помощь перемещение и переименование файлов с помощью 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 

Что мне нужно для кода, чтобы затем взять файл «1 ~ 1001-Text» в папке «A», переместите его к подпапке «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