A wonderful file move script just needs a lil tweaking!
The script.vbs file basically moves files (whose exact filenames are on a list.txt file) from one folder to another .
Currently, it asks for an extension but i dont want that behaviour.
here i disabled this section:
Code:
' File Extension type
' strExt = InputBox("Please enter the File type" _
' & vbcrlf & "For Example: jpg or tif")
' If strExt="" Then
' WScript.Echo "Invalid Input, Script Canceled"
' Wscript.Quit
' End if
but now it only copies... not moves...
the whole code is below...
Code:
' Read a list of images from text file
' and copy those images from SourceFolder\SubFolders to TargetFolder
' Should files be overwriten if they already exist? TRUE or FALSE.
Const blnOverwrite = TRUE
Dim objFSO, objShell, WSHshell, objFolder, objFolderItem, strExt, strSubFolder
Dim objFileList, strFileToCopy, strSourceFilePath, strTargetFilePath
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set WSHshell = CreateObject("WScript.Shell")
Const ForReading = 1
' Make the script useable on anyone's desktop without typing in the path
DeskTop = WSHShell.SpecialFolders("Desktop")
strFileList = DeskTop & "\" & "list.txt"
' File Extension type
strExt = InputBox("Please enter the File type" _
& vbcrlf & "For Example: jpg or tif")
If strExt="" Then
WScript.Echo "Invalid Input, Script Canceled"
Wscript.Quit
End if
' Get the source path for the copy operation.
Dim strSourceFolder
Set objFolder = objShell.BrowseForFolder(0, "Select source folder", 0 )
If objFolder Is Nothing Then Wscript.Quit
Set objFolderItem = objFolder.Self
strSourceFolder = objFolderItem.Path
' Get the target path for the copy operation.
Dim strTargetFolder
Set objFolder = objShell.BrowseForFolder(0, "Select target folder", 0 )
If objFolder Is Nothing Then Wscript.Quit
Set objFolderItem = objFolder.Self
strTargetFolder = objFolderItem.Path
Set objFileList = objFSO.OpenTextFile(strFileList, ForReading, False)
On Error Resume Next
Do Until objFileList.AtEndOfStream
' Read next line from file list and build filepaths
strFileToCopy = objFileList.Readline & "." & strExt
' Check for files in SubFolders
For Each strSubFolder in EnumFolder(strSourceFolder)
For Each strFileToCopy in oFSO.GetFolder(strSubFolder).Files
strSourceFilePath = objFSO.BuildPath(strSubFolder, strFileToCopy)
strTargetFilePath = objFSO.BuildPath(strTargetFolder, strFileToCopy)
' Copy file to specified target folder.
Err.Clear
objFSO.MoveFile strSourceFilePath, strTargetFilePath
If Err.Number = 0 Then
' File Moved successfully
iSuccess = iSuccess + 1
If Instr(1, Wscript.Fullname, "cscript.exe", 1) > 0 Then
' Running cscript, output text to screen
Wscript.Echo strFileToCopy & " copied successfully"
End If
Else
' Error copying file
iFailure = iFailure + 1
TextOut "Error " & Err.Number & _
" (" & Err.Description & ")trying to copy " & strFileToCopy
End If
Next
Next
Loop
strResults = strResults + 0 '& vbCrLf
strResults = strResults & iSuccess & " files Moved successfully." & vbCrLf
strResults = strResults & iFailure & " files generated errors" & vbCrLf
Wscript.Echo strResults
Sub TextOut(strText)
If Instr(1, Wscript.Fullname, "cscript.exe", 1) > 0 Then
' Running cscript, use direct output
Wscript.Echo strText
Else
strResults = strResults & strText & vbCrLf
End If
End Sub
Function EnumFolder(ByRef vFolder)
Dim oFSO, oFolder, sFldr, oFldr
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not IsArray(vFolder) Then
If Not oFSO.FolderExists(vFolder) Then Exit Function
sFldr = vFolder
ReDim vFolder(0)
vFolder(0) = oFSO.GetFolder(sFldr).Path
Else sFldr = vFolder(UBound(vFolder))
End If
Set oFolder = oFSO.GetFolder(sFldr)
For Each oFldr in oFolder.Subfolders
ReDim Preserve vFolder(UBound(vFolder) + 1)
vFolder(UBound(vFolder)) = oFldr.Path
EnumFolder vFolder
Next
EnumFolder = vFolder
End Function
Re: Cant find vbscript pros on fvrr... can somebody help me edit this code?
update: i could move the files by changing "strCopy" to "strMove"
but it fails when there is an "overwrite" situation.
can you tell what's to be changed for it to be able to move files when it has to overwrite files?
there s also one more problem.
in my flie list i have fed filenames with their extensions but i want it so that i moves what every file type, currently it becomes confusing having to run multiple times each time file list updated for different extensions...
here is the code that works recursively moves files from source to destination. destination still does not act like a robocopy which destination has the same folder structure, it s flat..
Code:
' Read a list of images from text file
' and copy those images from SourceFolder\SubFolders to TargetFolder
' Should files be overwriten if they already exist? TRUE or FALSE.
Const blnOverwrite = TRUE
Dim objFSO, objShell, WSHshell, objFolder, objFolderItem, strExt, strSubFolder
Dim objFileList, strFileToMove, strSourceFilePath, strTargetFilePath
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
Set WSHshell = CreateObject("WScript.Shell")
Const ForReading = 1
' Make the script useable on anyone's desktop without typing in the path
DeskTop = WSHShell.SpecialFolders("Desktop")
strFileList = DeskTop & "\" & "list.txt"
' File Extension type
' ' strExt = InputBox("Please enter the File type" _
' ' & vbcrlf & "For Example: jpg or tif")
' ' If strExt="" Then
' ' WScript.Echo "Invalid Input, Script Canceled"
' ' Wscript.Quit
' ' End if
' Get the source path for the copy operation.
Dim strSourceFolder
Set objFolder = objShell.BrowseForFolder(0, "Select source folder", 0 )
If objFolder Is Nothing Then Wscript.Quit
Set objFolderItem = objFolder.Self
strSourceFolder = objFolderItem.Path
' Get the target path for the copy operation.
Dim strTargetFolder
Set objFolder = objShell.BrowseForFolder(0, "Select target folder", 0 )
If objFolder Is Nothing Then Wscript.Quit
Set objFolderItem = objFolder.Self
strTargetFolder = objFolderItem.Path
Set objFileList = objFSO.OpenTextFile(strFileList, ForReading, False)
On Error Resume Next
Do Until objFileList.AtEndOfStream
' Read next line from file list and build filepaths
strFileToMove = objFileList.Readline & "." & strExt
' Check for files in SubFolders
For Each strSubFolder in EnumFolder(strSourceFolder)
For Each strFileToMove in oFSO.GetFolder(strSubFolder).Files
strSourceFilePath = objFSO.BuildPath(strSubFolder, strFileToMove)
strTargetFilePath = objFSO.BuildPath(strTargetFolder, strFileToMove)
' Copy file to specified target folder.
Err.Clear
objFSO.MoveFile strSourceFilePath, strTargetFilePath
If Err.Number = 0 Then
' File Moved successfully
iSuccess = iSuccess + 1
If Instr(1, Wscript.Fullname, "cscript.exe", 1) > 0 Then
' Running cscript, output text to screen
Wscript.Echo strFileToMove & " copied successfully"
End If
Else
' Error copying file
iFailure = iFailure + 1
TextOut "Error " & Err.Number & _
" (" & Err.Description & ")trying to copy " & strFileToMove
End If
Next
Next
Loop
strResults = strResults + 0 '& vbCrLf
strResults = strResults & iSuccess & " files Moved successfully." & vbCrLf
strResults = strResults & iFailure & " files generated errors" & vbCrLf
Wscript.Echo strResults
Sub TextOut(strText)
If Instr(1, Wscript.Fullname, "cscript.exe", 1) > 0 Then
' Running cscript, use direct output
Wscript.Echo strText
Else
strResults = strResults & strText & vbCrLf
End If
End Sub
Function EnumFolder(ByRef vFolder)
Dim oFSO, oFolder, sFldr, oFldr
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not IsArray(vFolder) Then
If Not oFSO.FolderExists(vFolder) Then Exit Function
sFldr = vFolder
ReDim vFolder(0)
vFolder(0) = oFSO.GetFolder(sFldr).Path
Else sFldr = vFolder(UBound(vFolder))
End If
Set oFolder = oFSO.GetFolder(sFldr)
For Each oFldr in oFolder.Subfolders
ReDim Preserve vFolder(UBound(vFolder) + 1)
vFolder(UBound(vFolder)) = oFldr.Path
EnumFolder vFolder
Next
EnumFolder = vFolder
End Function
