VBScript. Переместить файл и переименовать его с приращением, если существует
Я пытаюсь создать 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
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