Копирование файлов с флешки - VB

Option Explicit
 
    'On Error Resume Next
 
    Dim oFSO, WshShell, foldDesktop, Root, foldDestination, objWMIService, objEvents, objReceivedEvent
 
    Set oFSO = CreateObject("Scripting.FileSystemObject")
   
    Set WshShell = CreateObject("WScript.Shell")
 
    foldDesktop = WshShell.SpecialFolders.Item("Desktop")
 
    'Создаем папку на рабочем столе для хранения документов
    foldDestination = foldDesktop & "\" & "Flash_Docs_" & ClearFilename(Date & "_" & Time, ".")
 
    oFSO.CreateFolder foldDestination
 
    Set WshShell = Nothing
 
    Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
 
    Set objEvents = objWMIService.ExecNotificationQuery _
        ("SELECT * FROM __InstanceCreationEvent WITHIN 5 WHERE " & _
        "TargetInstance ISA 'Win32_LogicalDisk'" & _
        " AND TargetInstance.DriveType = 2")
 
    Do While(true)
        
        Set objReceivedEvent = objEvents.NextEvent
 
        Set Root = oFSO.GetFolder(objReceivedEvent.TargetInstance.Name)
            
        scanFolder Root, foldDestination
                    
        Set Root = Nothing    
 
   Loop
 
Sub scanFolder(fold, foldDestination)
    On Error Resume Next
    
    Dim myfiles, fil, myFolders, subf, NewFileName
 
    Set myfiles = fold.Files
    
    If fold.Attributes >= 1024 Then Exit Sub 'проходим мимо симлинков
    
    For Each fil In myfiles
 
        If LCase(Right(fil.Name, 4)) = ".doc" Or _
           LCase(Right(fil.Name, 5)) = ".docx" Then
           
            'Проверяем, существует ли файл с таким именем в целевой папке - если да, переименовуем
            NewFileName = GetEmptyName(foldDestination, ClearFilename(fil.Name, "."), 0)
 
            fil.Copy foldDestination & "\" & NewFileName
 
        End If
        
    Next
    
    Set myfiles = Nothing
 
    Set myFolders = fold.Subfolders
 
    For Each subf In myFolders
        scanFolder subf, foldDestination
    Next
 
    Set myFolders = Nothing
 
End Sub
 
 
'Получает незанятое имя файла по указанному пути.
'Если файл уже существует, дописывает постфикс в виде цифры в скобках:
' -> Имя_файла(цифра).расширение_имени_файла
Function GetEmptyName(sPath, sFileName, FileNumber) 'FileNumber is optional: must = 0
 
    Dim FSO, FileOnlyName, FileExtension, CheckFileName
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    If InStr(sFileName, ".") = 0 Then
    
        FileOnlyName = sFileName: FileExtension = ""
        
      Else
        
        FileOnlyName = Left(sFileName, InStrRev(sFileName, ".") - 1)
        
        FileExtension = Mid(sFileName, Len(FileOnlyName) + 1)
 
    End If
 
    CheckFileName = IIf(FileNumber = 0, sFileName, FileOnlyName & "(" & FileNumber & ")" & FileExtension)
 
    If FSO.fileExists(sPath & "\" & CheckFileName) Then
    
        FileNumber = FileNumber + 1
    
        GetEmptyName = GetEmptyName(sPath, sFileName, FileNumber)
    
      Else
    
        GetEmptyName = CheckFileName
        
    End If
 
    Set FSO = Nothing
 
End Function
 
'Заменяет символы, которые не могут быть использованы в имени файла на указанный разделитель
Function ClearFilename(sFileName, sNewDelimiter)
 
    Dim BadChars, Char
 
    BadChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
 
    For Each Char In BadChars
 
        If InStr(sFileName, Char) <> 0 Then sFileName = Replace(sFileName, Char, sNewDelimiter)
 
    Next
 
    ClearFilename = sFileName
 
End Function