End loop after comparing filename and copying it in Vbscript

Question

Im am trying to find files in a directory according to a list of numbers. Each file starts with the 6-digit- number but then can end with a random letters. - So i managed it to write a script which compares only the first six letters of the filename. Also I only want to copy .pdf and .dxf files -this is why I also check the filetype.

Just to make it more complicated the "Sourcefolder" is different for the files. It consist of the first 3 digits of the number and 2x "_". for example.

C:\files\258__\258956.pdf

This could be solved easily by adding to the sourcepath the first three digits and the __. (But isn't implemented yet)

The problem is my script does run infinitely because it never leaves the loop. Also it only checks the first number in the filelist.

I really searched in the Internet prior to this question. Also I would like to give props to the stackoverflow community, cause other questions really helped until now.

• I usually only script in vba (Excel) this is why I am unfamiliar with vbs.

Following a part of my filelist which defines which files have to be found

   127287
   257391
   257605
   258956
   261648
   261880
   261886
   262284

This is the script I already have

    dim fso, folder, sourcefolder, destfolder, searchname1,fileList

    set fso = createobject("scripting.filesystemobject") 
    sourcefolder = "C:\Users\Admin\Desktop\Source"
    destfolder = "C:\Users\Admin\Desktop\output\"
    inputFile = "C:\Users\Admin\Desktop\filelist.txt" 
    Set fileList = fso.OpenTextFile(inputFile, forReading) 

    ' Read line after line the next number which has to be found
    searchname1 = fileList.ReadLine() 

    ' But stop reading lines if the end is reached
    Do until fileList.AtEndOfStream 

    set folder = fso.getfolder(sourcefolder)  

    'Compare each file
    for each file in folder.files
        wholefilename = fso.getbasename(file)
        filename = left(wholefilename,6)
        extension = LCase(fso.getextensionName(file))

    'first compare the name with the list ¦ then check the fileextenstion 
        if (filename = searchname1) and  ((extension = "pdf") or (extension ="dxf")) then

    'it both statements are true, copy the file to the destinationfolder "Ouptut"
fso.copyfile sourcefolder & "\" & file.name, destfolder
else          
end if

    next
    Loop

The solution to my problem probably is super simple, but I'm really stuck. So any help is appreciated. Just to sum up, my big problem is, that the script never exits the loop. But I don't know how and when to end it, after 10'000 loops would be a dumb solution.

Answer 1

You need to move your ReadLine inside the Do loop like this:

Dim fso, folder, sourcefolder, destfolder, searchname1, fileList
Set fso = CreateObject("scripting.filesystemobject")
sourcefolder = "C:\Users\Admin\Desktop\Source"
destfolder = "C:\Users\Admin\Desktop\output\"
inputFile = "C:\Users\Admin\Desktop\filelist.txt"
Set fileList = fso.OpenTextFile(inputFile, forReading)

' But stop reading lines if the end is reached
Do Until fileList.AtEndOfStream
   ' Read line after line the next number which has to be found
   searchname1 = fileList.ReadLine()
   Set folder = fso.getfolder(sourcefolder)

   'Compare each file
   For Each File In folder.Files
       wholefilename = fso.getbasename(File)
       FileName = Left(wholefilename, 6)
       extension = LCase(fso.getextensionName(File))

       'first compare the name with the list ¦ then check the fileextenstion
       If (FileName = searchname1) And ((extension = "pdf") Or (extension = "dxf")) Then
          'it both statements are true, copy the file to the destinationfolder "Ouptut"
          fso.copyfile sourcefolder & "\" & File.name, destfolder
       End If
   Next
Loop