Подскажите, почему в следующей конструкции при попытке удалить папку Temp выдается runtime 70 Permission denied?
По идее должно происходить следующее: из папки с zip-архивами поочереди каждый архив распаковывается во временную папку, там нужный извлеченный файлик приоткрывается, читается дата из определенной ячейки, затем по этой дате дается файлику нужное имя, и он перемещается по заданному адресу в другую папку, а исходный извлеченный файлик удаляется, и на его место извлекается следующий. А после обработки всех архивов временная папка должна удалится, но - не удаляется! Предпринимал что мог, пробовал и RmDir, но - папка заблокирована каким-то процессом. Но каким? Может это архиватор, потому что если пропустить цикл For Each, то папка создается и удаляется как положено (кстати код разархивирования я списал откуда-то, не сильно вдумываясь в переменную RetVal).
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
Option Private Module
Dim FSO As FileSystemObject
Dim FolderArch, Temp As Folder
Dim Arch As File
Dim pathFolderArh, pathTemp As String
Sub UnArch()
'имя папки с zip-файлами
pathFolderArh = "C:\MyDocs\MyFolder\FolderArh\"
'имя временной папки для разархивирования zip-файлов и чтения данных из них
pathTemp = "C:\MyDocs\MyFolder\Temp\"
Set FSO = New FileSystemObject
Set FolderArch = FSO.GetFolder(pathFolderArh)
'создание временной папки
Set Temp = FSO.CreateFolder(pathTemp)
'каждый архив в архивном каталоге
For Each Arch In FolderArch.Files
'разархивировать в созданный временный каталог
Call RunArch
'если нужный файл был разархивирован,
If Temp.Files.Count = 1 Then
'то ему присваивается новое имя и он перемещается в нужную папку
Call NameDate
End If
Next
'удаление временной папки
Temp.Delete
Set Temp = Nothing
Set Arch = Nothing
Set FolderArch = Nothing
Set FSO = Nothing
End Sub
Sub RunArch()
RunRAR = "C:\Program Files\WinRAR\WinRAR.exe x -inul -nN01*.xls" & " """ & Arch.Path & """ """ & pathTemp & """"
'двойные кавычки позволяют работать с именем файла и путём, содержащими пробелы, без кавычек пробелы недопустимы
'х - разархивировать с путем извлечения
'-n - обрабатывать только файл, указанный по маске
'-inul — не выводить сообщения об ошибках
RetVal = Shell(RunRAR, vbHide)
End Sub
Sub NameDate()
Dim TempFile As File
Dim FileDateValue As String
Dim FileDate As Date
Dim FileYear, FileMonth, FileDay As Integer
'отключение обновления экрана, чтоб не мелькало
Application.ScreenUpdating = False
'файл во временной папке, который нужно переименовать и поместить в нужнуюю папку
Set TempFile = FSO.GetFile(pathTemp & Dir(pathTemp & "N01*" & ".xls"))
'открывание файла и нахождение в ячейке файла записи с датой отчетных данных
FileDateValue = GetObject(TempFile).Worksheets( 1 ).Range("A3").Value
'отбрасывание лишних символов из записи
FileDate = Left(Trim(FileDateValue), (Len(Trim(FileDateValue)) - 5 ))
'выделение года, месяца и числа
FileYear = Year(Format(FileDate, "Short Date"))
FileMonth = Month(Format(FileDate, "Short Date"))
FileDay = Day(Format(FileDate, "Short Date"))
'закрывание файла
GetObject(TempFile).Close
'копирование файла под новым именем в нужную папку
TempFile.Copy "C:\MyDocs\MyFolder\" & FileYear & "\" & FileMonth & "\" & FileDay & ".xls"
'удаление исходного файла из временной папки
TempFile.Delete
'включение обновления экрана
Application.ScreenUpdating = True
Set TempFile = Nothing
End Sub
