SQL2KDBA69
Programmer
i have a seach and copy sub but when it get an error 70 the program crash. here is the sub :
any help is appreciated.
Code:
Private Sub GetFolders(Folder)
On Error Resume Next
Dim fso2
Dim ObjFolder
Dim colFiles
Dim strName As String
Dim strPath As String
Dim strCopy As String
Set fso2 = CreateObject("Scripting.FileSystemObject")
For Each Subfolder In Folder.SubFolders
If Subfolder.Path <> "C:\UserFiles" Then
DoEvents
Set ObjFolder = fso2.GetFolder(Subfolder.Path)
Set colFiles = ObjFolder.Files
For Each objfile In colFiles
strName = objfile.Name
strPath = objfile.Path
If Len(strName) > 3 Then
If Right(UCase(strName), 4) = ".DOC" Or Right(UCase(strName), 4) = ".DOCX" Or _
Right(UCase(strName), 4) = ".PDF" Or Right(UCase(strName), 4) = ".XLS" Then
DoEvents
strCopy = "C:\UserFiles"
Print #1, "Source: " & strPath & " - Destination: " & strCopy & "\" & strName
lb_status.Caption = "Coping - " & strPath
lb_status.Refresh
If Not fso2.FileExists(strCopy & "\" & strName) Then
DoEvents
objfile.Copy (strCopy & "\" & strName)
End If
End If
End If
Next
End If
GetFolders Subfolder
Next
End Sub