Problems with FileSystemObject

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):

VB Code:

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 [vbcode][/vbcode] tags for clairty. - Hack

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?

try this:

just tightened it very small bit

VB Code:

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

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