Need help with my file search and copy script

[BossTurbo]

Hello all! This is my first script windows script I've ever written and I managed (eventually) to get it to work by scouring here and the internet for snippets and I managed to mangle it together. The problem is that it runs SLOOOW. I'm guessing because I'm searching for the files in a really dumb way, but this the only way I could figure out.

Basically the script is supposed to:
1) read a text file formatted in a specific way and grab the file name from each line (Does this great)
2) search for those files in a specified directory (using a "BrowseForFolder" window, objPath variable)
3) place found files in specified directory (again, using a "BrowseForFolder" window, objPathTarget variable)
4) Not take 3+ hours to find 50 files, lol

I tried putting the ShowSubFolders bit inside the Do loop, but it crashed on Sub ShowSubFolders(Folder).

Thank you for any guidance!
-brian


I call a BrowseForFolder window to get Source Path (objPath)
And another for Target Path (objPathTarget)... didnt' see the need to post the code and take up space


''''''''''''''''''''''''' Begin reading text file for file names and copy the files from all subdirectories
Set objFSO = CreateObject("Scripting.FileSystemObject")

ShowSubfolders objFSO.GetFolder(objPath)
Sub ShowSubFolders(Folder)
For Each Subfolder In Folder.SubFolders
Set objFile = objFSO.OpenTextFile("C:\Scripts\test.txt")
Do Until objFile.AtEndOfStream
strData = ""
strSearchString = objFile.ReadLine
intStart = InStr(strSearchString, "6) (")

If intStart <> 0 Then
intStart = intStart + 4
strText = Mid(strSearchString, intStart, 50)
For i = 1 To Len(strText)
If Mid(strText, i, 1) = ")" Then
Exit For
Else
strData = strData & Mid(strText, i, 1)
End If
Next
End If

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & Subfolder.Path & "'} Where " & "ResultClass = CIM_DataFile")
For Each objFile2 In colFiles
If LCase(strData) = objFile2.Filename Then ' Won't match unless use LCase
strCopy = objPathTarget & "\" & UCase(objFile2.FileName) & "." & UCase(objFile2.Extension) 'Put the file back to uppercase, the way it was
objFile2.Copy(strCopy)
End If
Next
Loop
ShowSubFolders Subfolder
Next
End Sub

 

[PHV]

Why mixing WMI and FSO ????

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[BossTurbo]

Hmm, because I have no idea what I'm doing? Didn't realize they were different... I'll see about changing the wmi to fso. Thanks for the bump in the right direction, it helps!

 

[BossTurbo]

Sweet, got it working GREAT now. Only takes about 15 seconds to copy 63 3MB files and searches through about 3000.

Here is the latest version (including GUI)...

Yes, there are some redundant variables, but I'm happy enough it works, I'm not gonna break it now, lol

Any comments, suggestions welcome. Thanks.

===========================================================================

''''''''''''''''''''''''''This opens a window for the user to find the event folder
Const WINDOW_HANDLE = 0
Const OPTIONS = 0

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select the event folder:", OPTIONS, MYCOMPUTER)

If objFolder Is Nothing Then
Wscript.Quit
End If

Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path

'''''''''''''''''''''''''This opens a window for the user to point new the new folder of the individuals images
Set objFolderTarget = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select the destination folder:", OPTIONS, objPath)

If objFolderTarget Is Nothing Then
Wscript.Quit
End If

Set objFolderItemTarget = objFolderTarget.Self
objPathTarget = objFolderItemTarget.Path


''''''''''''''''''''''''' Begin reading text file for file names and copy the files from all subdirectories

wscript.echo "Please allow the script up to a few minutes to gather all the files."

Set objDictionary = CreateObject("Scripting.Dictionary")
a = objDictionary.RemoveAll
Set objFSO = CreateObject("Scripting.FileSystemObject")

strStartFolder = objPath
objpathtarget= objPathTarget
j = 0

Set objTxtFile = objFSO.OpenTextFile("E:\Media\Images\__Motorsports\___Test\order.txt")
Set objFolder = objFSO.GetFolder(strStartFolder)
Set colFiles = objFolder.Files



Do Until objTxtFile.AtEndOfStream
strData = ""
strSearchString = objTxtFile.ReadLine
intStart = InStr(strSearchString, "6) (")

If intStart <> 0 Then
j=j+1
intStart = intStart + 4
strText = Mid(strSearchString, intStart, 50)
For i = 1 To Len(strText)
If Mid(strText, i, 1) = ")" Then
Exit For
Else
strData = strData & Mid(strText, i, 1)
End If
Next
If Not objDictionary.Exists(strName) Then
objDictionary.Add strData & ".JPG", j
End If

End If
Loop

ShowSubfolders objFSO.GetFolder(strStartFolder)
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files

For Each objFile In colFiles
strName = objFile.Name
strPath = objFile.Path
If objDictionary.Exists(strName) Then
strCopy = objPathTarget & "\" & objFile.Name
objFile.Copy(strCopy)
End If
Next
ShowSubFolders Subfolder
Next
End Sub

wscript.echo "Done!"
wscript.quit