JangooFett
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Нашел здесь такой скрипт, он копирует новые файлы в папку, но после копирования выдает ошибку:
Строка: 37
Символ: 6
Ошибка: Файл не найден
И как ему жестко указать на конкретную папку, без выбора?
Код:
Option Explicit
Dim fso, objShell, objFolder, NotFirst, flag
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Выбор начальной папки поиска", &H1, 17)
If Not objFolder Is Nothing Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder(objFolder.Self.path)
On Error Resume Next
fso.CreateFolder objFolder.path & "\" & Date
On Error GoTo 0
SearchAndMoveFiles objFolder, objFolder.path & "\" & Date
Else: wsh.Quit
End If
If flag Then
MsgBox "Новые файлы скопированы в '" & objFolder.path & "\" & Date & "\" & "'"
Else
MsgBox "Новые файлы не найдены"
End If
Set fso = Nothing
Set objFolder = Nothing
Set objShell = Nothing
Function SearchAndMoveFiles(fld, T_path)
Dim objSubFolder, objFile, DaysQ
If Not NotFirst Then
DaysQ = InputBox("Для поиска файлов введите кол-во дней," & vbCrLf _
& "предшествующих сегодняшнему.", , 3)
If DaysQ = "" Then wsh.Quit ' Завершение без сообщения
If Not IsNumeric(DaysQ) Or DaysQ = 0 Or DaysQ > 5 Then wsh.Quit ' Завершение без сообщения
End If
For Each objFile In fld.Files
If (Now - objFile.DateLastModified) < DaysQ + 1 Then
If T_path <> fld.path Then
objFile.Copy T_path & "\"
flag = True
End If
End If
Next
NotFirst = True
For Each objSubFolder In fld.SubFolders
SearchAndMoveFiles objSubFolder, T_path
Next
Set objSubFolder = Nothing
Set objFile = Nothing
End Function
|
|
Всего записей: 4 | Зарегистр. 23-08-2011 | Отправлено: 08:38 29-08-2011 | Исправлено: JangooFett, 10:51 29-08-2011 |
|
