Greetings, i am trying to modify a vbscript that i have found on a now defunct(unfortunately) forum ( A script for copying certain files to a new location ).
I see similar requests from other users regarding the “move” function but those calls were not answered at the time.
The code is working quite well for copying.
The list of files to copy. Should be a text file with one file on each row. No paths - just file name.
Const strFileList = "\\whitewalker2018\Users\bdogr\Desktop\list.txt"
' Should files be overwriten if they already exist? TRUE or FALSE.
Const blnOverwrite = FALSE
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objShell
Set objShell = CreateObject("Shell.Application")
Dim objFolder, objFolderItem
' Get the source path for the copy operation.
Dim strSourceFolder
Set objFolder = objShell.BrowseForFolder(0, "Select source folder", 0 , "\\whitewalker2018\W4tb on Wv\!_CgTorrents")
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 , "\\whitewalker2018\W4tb on Wv\!_CgTorrents")
If objFolder Is Nothing Then Wscript.Quit
Set objFolderItem = objFolder.Self
strTargetFolder = objFolderItem.Path
Const ForReading = 1
Dim objFileList
Set objFileList = objFSO.OpenTextFile(strFileList, ForReading, False)
Dim strFileToCopy, strSourceFilePath, strTargetFilePath
Dim strResults, iSuccess, iFailure
iSuccess = 0
iFailure = 0
On Error Resume Next
Do Until objFileList.AtEndOfStream
' Read next line from file list and build filepaths
strFileToCopy = objFileList.Readline
strSourceFilePath = objFSO.BuildPath(strSourceFolder, "*" & strFileToCopy & "*")
strTargetFilePath = strTargetFolder
' Copy file to specified target folder.
Err.Clear
objFSO.CopyFile strSourceFilePath, strTargetFilePath, blnOverwrite
If Err.Number = 0 Then
' File copied 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
Loop
strResults = strResults & vbCrLf
strResults = strResults & iSuccess & " files copied 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
I replaced all “Copy” words to “move” but the script does not work.
Maybe it can work with some simple tweaks?
Hello. This is a forum for Powershell, not vbscript. It seems like you’re simply trying to copy or move files? You can look into Copy-Item, Move-Item, and Get-ChildItem. These commands have great help files you can find online or in powershell itself. These 3 cover looking for/collecting file/folder info and copy/move. The examples in the help should get you started. And for reading text files for a list you can use Import-Csv or Get-Content. Again, read the help for these entirely and you’ll see why powershell is so much easier and more powerful than vbscript.
1 Like
Helo, @krzydoug i have just been free off an interior design project and with the limited energy left out, i was trying to get back at my lousy 3d asset library, so i found thie vbscript and though maybe just replacing the “copy” word to move would solve it and it did not… I am not into scripting much nor have the desire to take on coding atm, just wanted to know if a quick glimpse would solve things for the easier.
thnx for the input though and i admit i am just trying to get spoon-fed here and in return , let people find this post as i was not the only one looking for this exact behavior from the script.
this script actually ran on windows shell but later it was saved as a vbscript so this is now vbscript or shell script i also have no idea…
Only had the briefest look at this but the Move() method doesn’t support the overwrite option, so you’d need to remove the overwrite option. If everything else works, then all you should need to do is replace:
objFSO.CopyFile strSourceFilePath, strTargetFilePath, blnOverwrite
with
objFSO.MoveFile strSourceFilePath, strTargetFilePath
1 Like
You are absolutely right about that @matt-bloomfield , just changing that line , the script was able to move the files. the message at the end was still reporting to be copying files but i checked and it really moves it. (edited the message at the end so it reports “moved” correctly.
I also noticed that the script was working on flat folder hierarchy, thus not able to find files that are inside folders and even it did, it would move them to a flat folder instead of recreating the folder structure at the destination. Maybe i should create post about modifying it so it behaves like the much beloved robocopy with /s but with a file list feature…
so here is the code for moving files from a flat (no sub folder support)directory to another directory (flat again)
type or paste code here' The list of files to copy. Should be a text file with one file on each row. No paths - just file name.
Const strFileList = "c:\list.txt"
' Should files be overwriten if they already exist? TRUE or FALSE.
Const blnOverwrite = FALSE
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objShell
Set objShell = CreateObject("Shell.Application")
Dim objFolder, objFolderItem
' Get the source path for the copy operation the path below is for setting a redefined folder for easier navigation.
Dim strSourceFolder
Set objFolder = objShell.BrowseForFolder(0, "Select source folder", 0 , "c:\sourcefolder")
If objFolder Is Nothing Then Wscript.Quit
Set objFolderItem = objFolder.Self
strSourceFolder = objFolderItem.Path
' Get the target path for the copy operation the path below is for setting a redefined folder for easier navigation.
Dim strTargetFolder
Set objFolder = objShell.BrowseForFolder(0, "Select target folder", 0 , "c:\targetfolder")
If objFolder Is Nothing Then Wscript.Quit
Set objFolderItem = objFolder.Self
strTargetFolder = objFolderItem.Path
Const ForReading = 1
Dim objFileList
Set objFileList = objFSO.OpenTextFile(strFileList, ForReading, False)
Dim strFileToCopy, strSourceFilePath, strTargetFilePath
Dim strResults, iSuccess, iFailure
iSuccess = 0
iFailure = 0
On Error Resume Next
Do Until objFileList.AtEndOfStream
' Read next line from file list and build filepaths
strFileToCopy = objFileList.Readline
strSourceFilePath = objFSO.BuildPath(strSourceFolder, "*" & strFileToCopy & "*")
strTargetFilePath = strTargetFolder
' Copy file to specified target folder.
Err.Clear
objFSO.MoveFile strSourceFilePath, strTargetFilePath
If Err.Number = 0 Then
' File copied 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
Loop
strResults = strResults & 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
and this is the version that moves recursively , one caveat, source folder recursive(searches in sub folders) but target is flat. ok imo
' 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 copied 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