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