Saving a new file with one alphabet preceeding

Question

Please find the code:

Problem is the folder has a large no. of files

=====================================================================================
Dim fso, objFolder, obFileList, folderpath,counter

folderpath = "G:\Everyone\Model Office Testing Documents\HP QC\QTP\PSISAutomation\Logs"

Set fso = CreateObject("Scripting.FileSystemObject")

Set objFolder = fso.GetFolder(folderpath)

Set objFileList = objFolder.Files


For Each File In objFileList
    msgbox("5")
     If InStr(1,File.Name,"DE_For_Pol_Print_APPA_7A_Copy_") = 1 Then        
        counter=counter+1
     End If   
Next 

counter=counter+1
msgbox("new file will be saved as: " &"DE_For_Pol_Print_APPA_7A_Copy_"& Chr(64 + Counter))

The folder is present in a network location and also it is having large no. of files......loop takes much time For Each File In objFileList msgbox("5") If InStr(1,File.Name,"DE_For_Pol_Print_APPA_7A_Copy_") = 1 Then counter=counter+1 End If Next — Guri

AutomatedChaos AutomatedChaos · Accepted Answer · 2011-05-06T11:03:54

Do not use the FSO, but make use of the WMI where you put the filename in the SELECT statement, like: "DE_For_Pol_Print_APPA_7A_Copy_%". This should return a collection with only files with the requested filename (faster than a total collection).

There is no count property for file collections, but you can use:

For Each file in fileCollection
    counter = counter + 1
Next

This will not access the internal file object and should run reasonably fast.

A second and even faster (but uglier imo) technique is to use the command prompt from a windowshell object and return the dir to the output. The output is just a string. Now, count the amount of matches on your desired string (DE_For_Pol_Print_APPA_7A_Copy_) and that is your counter.

The exact code is left blank as an excercise for the poster.

Saving a new file with one alphabet preceeding

1 Answers