Quantcast
Channel: VBForums - ASP, VB Script
Viewing all articles
Browse latest Browse all 688

IDK whats wrong... "Eliminating unnecessary files from a folder with a filelist"

$
0
0
Hello,

This is working just fine but when the filelist is too large....( too many filenames), it moves some files and then stops.... not show an end result message of sucess or failure...

Code:

123456.12ab34cd56ef
234567.23ab45cd56ef
345678.894gh45123s

So the script tries to move any files(jpg and rar files) that contains those names above.

Code:

' The list of files to copy. Should be a text file with one file on each row. No paths - just file name.
' I wish i can just say" parent folder of the script file to look for a list file instead of pathing the desktop folder
Const strFileList = "\\whitewalker2018\Users\bdogr\Desktop\3dsky_tagged_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 )
Set objFolder = objShell.BrowseForFolder(0, "Select source folder", 0 , "W:\")
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 )
Set objFolder = objShell.BrowseForFolder(0, "Select target folder", 0 , "\\whitewalker2018\W4tb on Wv\!_CgTorrents\!_DupesID")
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
    strFileToMove = objFileList.Readline
    strSourceFilePath = objFSO.BuildPath(strSourceFolder, "*" & strFileToMove & "*")
    strTargetFilePath = strTargetFolder
    ' Move 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 strFileToMove & " copied successfully"
        End If
    Else
        ' Error copying file
        iFailure = iFailure + 1
        TextOut "Error " & Err.Number & " (" & Err.Description & ") trying to Move " & 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


The filelist contains 30k filenames. can this be the cause ?

Viewing all articles
Browse latest Browse all 688

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>