Problems with FileSystemObject

[dacount97]

I have built a VB app to take in a query of product #s, then search for all pictures associated with that product on a local machine, then those that are found are copied into a seperate file to be distributed out. The probloem I am having is that it is very slow, and yet it only uses 10% CPU Max and 17,000 k memory max. I need to find a way to speed it up, if anyone has any suggestions.

Thanks,
Dan

Code snippet here (which is called passing in the ProdNums in a loop over the recordset):Private Sub CopyPhotos(ProdNum)
Dim intCntr, LastTwo As Integer
Dim ThisPhoto, ThisPhotoPath As String
LastTwo = Right(ProdNum, 2)
ThisPhotoPath = RootPath & "\" & LastTwo
intCntr = 0
'On Error GoTo errHandler
'Check that the photo folder exists
If Not myFSO.FolderExists(ThisPhotoPath) Then
GoTo NoFolder
End If
'Check Desitnation Folder
If Not myFSO.FolderExists(CopyPath & "\" & LastTwo) Then
myFSO.CreateFolder CopyPath & "\" & LastTwo
End If
'Loop over all possible photo combos
Do While intCntr <= MaxPhotos
'Check for this photo
ThisPhoto = ThisPhotoPath & "\" & ProdNum& "_" & intCntr & ".jpg"
If Not myFSO.FileExists(ThisPhoto) Then
GoTo NoPhoto
End If
myFSO.CopyFile ThisPhoto, CopyPath & "\" & LastTwo & "\"
NextPhoto:
intCntr = intCntr + 1
Loop
GoTo UnloadSub
NoFolder:
WriteUserError ("Folder for " & ProdNum& " Photo does not exist ( " & ThisPhotoPath & " )")
GoTo UnloadSub
NoPhoto:
WriteUserError ("Photo for " & ProdNum& " Photo does not exist ( " & ThisPhoto & " )")
GoTo NextPhoto
UnloadSub:
Exit Sub
errHandler:
If ErrMustStop Then Debug.Assert False: Resume
ErrorIn "Form1.MoveFiles(RootPath)", RootPath
End Sub



Edit: Added tags for clairty. - Hack

[Dave Sell]

The bottleneck here is your disk access. Get a faster disk. That's all you can do. Need recommendations on how to get a faster disk?

[ZeBula8]

try this:

just tightened it very small bit


Private Sub CopyPhotos(ProdNum)
'Dim intCntr, LastTwo As Integer
'Dim ThisPhoto, ThisPhotoPath As String

Dim intCntr As Long
Dim LastTwo As Long
Dim ThisPhoto As String
Dim ThisPhotoPath As String
Dim sFolder As String



LastTwo = Right(ProdNum, 2)
sFolder = CopyPath & "\" & LastTwo
ThisPhotoPath = RootPath & "\" & LastTwo

intCntr = 0

'On Error GoTo errHandler
'Check that the photo folder exists
If Not myFSO.FolderExists(ThisPhotoPath) Then
GoTo NoFolder
End If

'Check Desitnation Folder
If Not myFSO.FolderExists(sFolder) Then
myFSO.CreateFolder sFolder
End If

'Loop over all possible photo combos
Do While intCntr <= MaxPhotos
'Check for this photo
ThisPhoto = ThisPhotoPath & "\" & ProdNum & "_" & intCntr & ".jpg"

If myFSO.FileExists(ThisPhoto) Then
myFSO.CopyFile ThisPhoto, sFolder & "\"
End If
intCntr = intCntr + 1
Loop

GoTo UnloadSub


NoFolder:
WriteUserError ("Folder for " & ProdNum & " Photo does not exist ( " & ThisPhotoPath & " )")
GoTo UnloadSub

NoPhoto:
WriteUserError ("Photo for " & ProdNum & " Photo does not exist ( " & ThisPhoto & " )")
GoTo NextPhoto

UnloadSub:
Exit Sub

errHandler:
If ErrMustStop Then Debug.Assert False: Resume
ErrorIn "Form1.MoveFiles(RootPath)", RootPath
End Sub

[dacount97]

I appreciate the replies, I have changed my approach to now building a .bat that has all the copy commands in it, then calling that .bat. It's definately slow on the actual copy process, it builds the .bat files pretty fast. I think one of the main issues is we are talking about 15+ gigs of files and about 333,000 products with a possible 10 photos per product. I have split the bat files up into 1-9 based on the last 2 digits of the product code, and am running 2 bats at a time, trying to see if that speeds it up at all.

If anyone has any better ideas, I would love to hear it.

Thanks,
Dan