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 As String, dDir As String, old_name As String, 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 As String, tDir As String, 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 & " " & Chr(34) & oldFile & Chr(34) & _               " " & Chr(34) & nFile & Chr(34)      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).

Один из комментаторов, пользователь @B13nerdпредложил более оптимальный и быстрый код, большое ему спасибо!

Option Explicit  Private Enum BOOL   FALSE_BOOL = 0   TRUE_BOOL = 1 End Enum  'BOOL CopyFile( '  [in] LPCTSTR lpExistingFileName, '  [in] LPCTSTR lpNewFileName, '  [in] BOOL    bFailIfExists '); Private Declare PtrSafe Function CopyFile Lib "kernel32" Alias "CopyFileW" ( _   ByVal sExistingFileName As LongPtr, _   ByVal sNewFileName As LongPtr, _   ByVal bFailIfExists As BOOL) As BOOL  Private Const MAX_PATH As Long = 260  Private Sub MakeLongFileName(ByRef sFileName As String)   Const PREFIX As String = "\\?\"   Const PREFIX_LEN As Long = 4   If Len(sFileName) >= MAX_PATH Then     If StrComp(Left$(sFileName, PREFIX_LEN), PREFIX) Then       sFileName = PREFIX & sFileName     End If   End If End Sub  Public Function MyCopyFile( _   ByVal sExistingFileName As String, _   ByVal sNewFileName As String) As Long      MakeLongFileName sExistingFileName   MakeLongFileName sNewFileName      CopyFile StrPtr(sExistingFileName), StrPtr(sNewFileName), TRUE_BOOL   MyCopyFile = Err.LastDllError '0 - Ok, 3 - путь не найден, 80 - файл с таким именем уже существует End Function  Public Sub Test1()   Dim sSrcPath As String   sSrcPath = "D:\Doc\source.ext" 'файл - исходник, может быть любой длинный путь   Dim sDstPath As String   'файл цель, тоже может может быть любой допустимый длинный путь   sDstPath = "D:\Download\" & _     "ajdhjfkwofnwdiowdkncionioweudnmnspcjwpjedpjqpsdmpqlmsdpmnohfoqpwdsmnondoqhodhoq\" & _     "kmedfopqmpsmxcopmndcoibnoqwdqpmsdcppxinqionwedonqpwdmpmpmpqnowidiqdnpmnqpwdpqnw\" & _     "mcwmnediqncniqnwondonqnwdpqjwodjpqjwddiondnnq23ejnwqdnqowjdndxnqowndioqnwid\" & _     "qknmwdqinwod89wndkqn892dnkqnd89qhd8qwndilqndqw89dhqonwdnqklnwdlq8wjhdqwdklmnqiw\" & _     "destination.ext"   Debug.Print MyCopyFile(sSrcPath, sDstPath) End Sub

Целевая директория должна существовать, т.е. перед манипуляциями с файлами, убедитесь что целевая директория существует, а если нет, тогда надо её создать.