Mar 05 2022 11:35 AM
This script below
' 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
basically, lets you pick up target and destination folders, then by using a "list.txt" it copies all similarly named files to destination. It has been useful to many people that was written by a user @perhof (original post: https://social.technet.microsoft.com/Forums/en-US/59eed295-a18f-4c78-9b87-cf211c2e58b2/a-script-for-...
My idea to replace all "copy" word to "move" did fail, i already checkd if a function "objFSO.MoveFile" exists so i dont know the problem here nor the knowledge to read through the code and fix. i am a 3d interior designer. so
help me and a thousand more people like me that needs this; thank you
' The list of files to Move. 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 Move 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 Move 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 strFileToMove, 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
strFileToMove = objFileList.Readline
strSourceFilePath = objFSO.BuildPath(strSourceFolder, "*" & strFileToMove & "*")
strTargetFilePath = strTargetFolder
' Move file to specified target folder.
Err.Clear
objFSO.MoveFile 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 strFileToMove & " copied successfully"
End If
Else
' Error Moveing file
iFailure = iFailure + 1
TextOut "Error " & Err.Number & " (" & Err.Description & ") trying to Move " & strFileToMove
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
Mar 06 2022 01:13 AM
Anybody can take a glimpse? it just has to move instead of "copy" and i replaced them but it does not work...
Mar 06 2022 01:38 AM
Mar 06 2022 07:31 PM