0

ファイルをあるディレクトリから別のディレクトリに移動し、ファイルが既に存在する場合はファイル名をインクリメントする vbscript を作成しようとしています。つまり、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
4

1 に答える 1

2

スクリプトがまったく理解できないので、「カウンターをインクリメントして新しいファイル名を作成する」というタスクに集中します。明らかに、宛先フォルダーに同じ名前またはこの名前 + サフィックスのファイルがあるかどうかを各ファイルについて確認する必要があります。ファイル 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
于 2013-01-31T08:25:34.687 に答える