VBA, Windows 10: манипуляция файлами с длинными путями
Недавно, работая в VBA, я попытался переименовать группу файлов, расположенных в длинных, вложенных директориях. Неожиданно возникли ошибки, которые не позволяли это осуществить. Оказалось, что в Windows 10 (тем более в более ранних версиях) существуют ограничения на длину путей (см., к примеру https://learn.microsoft.com/ru-ru/windows/win32/fileio/maximum-file-path-limitation? tabs=registry). Решения, найденные в результате поиска не принесли результата. Да, для манипуляции с длинными путями необходимо разрешить их в реестре (раздел Computer\HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\FileSystem\LongPathsEnabled (Type: REG_DWORD) реестра должен существовать и иметь значение 1), но даже если они будут разрешены, манипулировать вы ими не можете, т.к. сам проводник Windows не позволяет работать с длинными путями. Возможно, скрипт VBA, при манипуляции с файлами использует проводник Windows. С другой стороны, с длинными путями хорошо работает проводник 7-Zip File Manager, при этом он имеется практически на каждом компьютере. Если это не так — его легко установить.
Возникла идея обойти ограничения Windows и использовать для манипуляции с файлами именно проводник 7-Zip File Manager. В результате получился рабочий скрипт, который позволяет производить перемещение и переименование файлов с длинными путями.
'Пример использования функции перемещения файлов с длинными путями
Public Sub Per_Files()
Dim sDir, dDir, old_name, new_name As String
sDir = "C:\1\" 'Исходная папка"
dDir = "C:\2\" 'Целевая папка
old_name = "1.pdf" 'Копируемый файл: старое имя
new_name = "1-1.pdf" 'Копируемый файл: новое имя
Call cp7z(sDir, dDir, old_name, new_name)
End Sub
'Подпрограмма перемещения файлов с длинными путями с помощью архиватора 7z
Public Sub cp7z(ByVal sDir As String, ByVal dDir As String, ByVal oldFile As String, ByVal nFile As String)
Dim PrDir, tDir, comstr As String
PrDir = """C:\Program Files\7-Zip\7z.exe""" 'Расположение исполняемого файла 7z
tDir = "C:\tmp\tmp.7z" 'Вспомогательная папка и файл
'Проверка существования файла tmp.7z. Если такой файл есть - подбирается новое свободное имя
Do While Dir(tDir) <> ""
tDir = "C:\tmp\" & WorksheetFunction.RandBetween(1, 1000) & "tmp.7z"
' MsgBox tDir
Loop
'Создание архива C:\tmp\*tmp.7z из исходного файла с длинным путём (без компрессии, т.е. копирование в файл *tmp.7z)
comstr = PrDir & " a -mx0 " & tDir & " " & Chr(34) & sDir & oldFile & Chr(34)
Debug.Print comstr
ShellAndWait comstr
'Переименование файла в архиве C:\tmp\*tmp.7z старое имя -> новое имя
comstr = PrDir & " rn " & tDir & " " & oldFile & " " & nFile
Debug.Print comstr
ShellAndWait comstr
'Копирование файла из архива C:\tmp\*tmp.7z в целевую папку
comstr = PrDir & " e -y " & tDir & " -o" & Chr(34) & dDir & Chr(34)
Debug.Print comstr
ShellAndWait comstr
'Удаление вспомогательного файла
Kill tDir
End Sub
'Подпрограмма запуска процесса 7z с ожиданием завершения процесса
Sub ShellAndWait(pathFile As String)
Dim WshShell As Object
Set WshShell = CreateObject("Wscript.Shell")
WshShell.Run pathFile, 0, True 'Обязательно True, процесс должен завершиться,
'иначе команды скрипта начнут выполняться раньше срока и скрипт не будет работать
End SubКак видно из скрипта, необходимый файл архивируется архиватором 7z во вспомогательную папку во временный файл (без сжатия), а затем распаковывается в файл по новому пути. Временный файл удаляется. При этом файл может быть переименован. В данном случае, в скрипте, в качестве исходных и целевых папок используются папки «C:\1\» и «C:\2\», но в вашем скрипте вы можете задавать пути (в виде переменных string) любой длины и вложенности.
Данный скрипт осуществляет перемещение файлов. Вы можете реализовать функции копирования или переименования, слегка модифицировав скрипт.
И не забывайте, что для функционирования данного скрипта, у вас на компьютере должен быть установлен архиватор 7z и в скрипте необходимо прописать правильный путь к исполняемому файлу архиватора (переменная PrDir).
