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

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