VB脚本。如果存在，移动文件并以增量重命名

Question

我正在尝试创建一个 vbscript，将文件从一个目录移动到另一个目录，如果文件已经存在，则增加文件名。 IE。如果 file.ext 存在，则新文件名为 file_01.ext。如果 file_01.ext 存在，则新文件名为 file_02.ext，依此类推。我无法让它工作。任何帮助将不胜感激。

Const cVBS = "Vaskedama.vbs"     '= script name
Const cLOG = "Vaskedama.log"     '= log filename
Const cFOL = "C:\fra\"          '= source folder
Const cMOV = "C:\til\"              '= dest. folder
Const cDAZ = -1                      '= # days

Dim strMSG
    strMSG = " files moved from " & cFOL & " to " & cMOV
MsgBox Move_Files(cFOL) & strMSG,vbInformation,cVBS

Function Move_Files(folder)
    Move_Files = 0

    Dim strDAT
    Dim intDAZ
    Dim arrFIL()
  ReDim arrFIL(0)
    Dim intFIL
        intFIL = 0
    Dim strFIL
    Dim intLEN
        intLEN = 0
    Dim strLOG
        strLOG = "echo " & cVBS & " -- " & Now & vbCrLf
    Dim dtmNOW
        dtmNOW = Now

    Dim objFSO
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objGFO
    Dim objGFI

    If Not objFSO.FolderExists(cFOL) _
    Or Not objFSO.FolderExists(cMOV) Then
        MsgBox "A folder does not exist!",vbExclamation,cVBS
        Exit Function
    End If

    Set objGFO = objFSO.GetFolder(folder)
    Set objGFI = objGFO.Files

    For Each strFIL In objGFI
        strDAT = strFIL.DateCreated
        intDAZ = DateDiff("d",strDAT,dtmNOW)
        If intDAZ > cDAZ Then
            intFIL = intFIL + 1
            ReDim Preserve arrFIL(intFIL)
            arrFIL(intFIL) = strFIL.Name
            If intLEN < Len(strFIL.Name) Then
                intLEN = Len(strFIL.Name)
            End If
        End If
    Next

    For intFIL = 1 To UBound(arrFIL)
        strFIL = arrFIL(intFIL)
        Do While (objFSO.FileExists(cMOV & strFIL))
        strFil = CreateNewName(strFIL, intFIL)
        Loop
        objFSO.MoveFile folder & strFIL, cMOV & strFIL
        strLOG = strLOG & "move " & folder & strFIL _
               & Space(intLEN-Len(strFIL)+1) _
               & cMOV & strFIL & vbCrLf
    Next

    Set objGFI = Nothing
    Set objGFO = Nothing
        strLOG = strLOG & "echo " & UBound(arrFIL) & " files moved"
        objFSO.CreateTextFile(cLOG,True).Write(strLOG)
    Set objFSO = Nothing

    Move_Files = UBound(arrFIL)
End Function

Function CreateNewName(strValue, intValue)
    CreateNewName = strValue & intValue
End Function

Answer 1

由于我根本无法理解您的脚本，因此我将专注于“通过递增计数器来构建新文件名”的任务。显然，您必须检查每个文件在目标文件夹中是否存在同名文件或此名称+后缀的文件。文件 a 的这个问题的答案完全独立于源文件夹中的所有文件 - 所以我怀疑你的数组是否有意义。

在代码中：

  Const cnMax = 3

  Dim goFS    : Set goFS    = CreateObject("Scripting.FileSystemObject")

  Dim oSrcDir : Set oSrcDir = goFS.GetFolder("..\testdata\FancyRename\from")
  Dim sDstDir : sDstDir     = "..\testdata\FancyRename\to"
  Dim oFile, nInc, sNFSpec
  For Each oFile In oSrcDir.Files
      WScript.Echo "looking at", oFile.Name
      nInc    = 0
      sNFSpec = getNewFSpec(oFile.Name, sDstDir, nInc)
      Do While goFS.FileExists(sNFSpec) And nInc <= cnMax
         sNFSpec = getNewFSpec(oFile.Name, sDstDir, nInc)
      Loop
      If nInc > cnMax Then
         WScript.Echo "won't copy to", sNFSpec
      Else
         WScript.Echo "will copy to ", sNFSpec
         oFile.Copy sNFSpec
      End If
  Next

Function getNewFSpec(ByVal sFName, sDstDir, ByRef nInc)
  If 0 < nInc Then
     Dim sSfx
     sSfx = goFS.GetExtensionName(sFName)
     If "" <> sSfx Then sSfx = "." & sSfx
     sSfx = "_" & Right("00" & nInc, 2) & sSfx
     sFName = goFS.GetBaseName(sFName) & sSfx
  End If
  nInc        = nInc + 1
  getNewFSpec = goFS.BuildPath(sDstDir, sFName)
End Function

一些示例输出：

looking at B.txt
will copy to  ..\testdata\FancyRename\to\B.txt
looking at C.txt
will copy to  ..\testdata\FancyRename\to\C.txt
looking at A.txt
will copy to  ..\testdata\FancyRename\to\A.txt

looking at B.txt
will copy to  ..\testdata\FancyRename\to\B_01.txt

looking at B.txt
won't copy to ..\testdata\FancyRename\to\B_03.txt