Kutush Oct 24 2023 at 18:16

VBA, Windows 10: манипуляция файлами с длинными путями

Easy

4 min

Visual Basic for Applications*

From sandbox

Comments 16

fido_max Oct 24 2023 at 20:35

А еще 8192 символ в cmd консольке пропадает. Причем строка не обрезается, а просто символ пропадает. https://stackoverflow.com/questions/2916865/how-to-get-around-the-command-line-length-limit

Kutush Oct 26 2023 at 00:30

Но это по крайней мере не ограничение в 260 символов ). Я не думаю, что в практической деятельности встречаются пути длиной более 8000 символов...

aamonster Oct 24 2023 at 22:20

Так вы пути-то длинные в своём скрипте записывали в виде \?\...? Или 7zip только для этого и использовали (типа в скрипте обычная запись, а в эту извращённую пусть 7zip переводит)?

Kutush Oct 26 2023 at 00:27

Пробовал, и много различных способов записи длинных путей - не получается при использовании стандартных функций манипуляции файлов VBA. Не позволяет.

mesvobodnye Oct 25 2023 at 08:47

Для перемещения таких файлов используем Тотал Коммандер

Kutush Oct 26 2023 at 00:25

Допустимо, если это 2-3 файла. У меня была задача переименовать тысячи файлов в длинных вложенных папках с именами в которых содержалось полное название госта + допинфа (очень очень длинное) - то есть в ручную это сделать нереально.

Может быть вы знаете как использовать тотал в VBA подобно вышеописанному способу 7z? Подскажите, можно ли из строки шела выполнять команды Тотала на копирование, перемещение и тп.

Kutush Oct 27 2023 at 00:11

Поискал сегодня - на сайте разработчика есть раздел по работе с шелом: https://www.ghisler.ch/wiki/index.php?title=Command_line_parameters

К сожалению, не имеется команд для манипуляции с файлами.

VIGOTiraspol Oct 27 2023 at 00:00

TC не работает с длинными именами.

Kutush Oct 29 2023 at 17:52

Работает. Поставил последнюю версию ТС (11.01) - папки с длинными путями создаёт, при копировании туда файлов выдаёт предупреждение, что путь очень длинный, при подтверждении своего намерения - позволяет записать файл.

B13nerd Oct 25 2023 at 08:47

1) Если VBA (не VBS), почему не использовать WinAPI CopyFile() с добавлением к пути "\\?\" ?

2) Dim sDir, dDir, old_name, new_name As String - типичная ошибка (так сказать). sDir, dDir, old_name будут описаны как Variant.

Kutush Oct 26 2023 at 00:21

Пробовал. У меня не получилось. Предложите рабочий вариант.

B13nerd Oct 27 2023 at 14:40

Проверял в Windows 10, VBA 64 бит, ключ реестра HKLM\SYSTEM\ControlSet001\Control\FileSystem\LongPathsEnabled равен 1, файловая система - NTFS.

Код VBA

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

Целевая директория должна существовать.

До выполнения процедуры Test1 в командной консоли:

D:\Download\ajdhjfkwofnwdiowdkncionioweudnmnspcjwpjedpjqpsdmpqlmsdpmnohfoqpwdsmnondoqhodhoq\kmedfopqmpsmxcopmndcoibnoqwdqpmsdcppxinqionwedonqpwdmpmpmpqnowidiqdnpmnqpwdpqnw\mcwmnediqncniqnwondonqnwdpqjwodjpqjwddiondnnq23ejnwqdnqowjdndxnqowndioqnwid\qknmwdqinwod89wndkqn892dnkqnd89qhd8qwndilqndqw89dhqonwdnqklnwdlq8wjhdqwdklmnqiw>dir
 Том в устройстве D имеет метку XXXX
 Серийный номер тома: XXXX-XXXX

 Содержимое папки D:\Download\ajdhjfkwofnwdiowdkncionioweudnmnspcjwpjedpjqpsdmpqlmsdpmnohfoqpwdsmnondoqhodhoq\kmedfopqmpsmxcopmndcoibnoqwdqpmsdcppxinqionwedonqpwdmpmpmpqnowidiqdnpmnqpwdpqnw\mcwmnediqncniqnwondonqnwdpqjwodjpqjwddiondnnq23ejnwqdnqowjdndxnqowndioqnwid\qknmwdqinwod89wndkqn892dnkqnd89qhd8qwndilqndqw89dhqonwdnqklnwdlq8wjhdqwdklmnqiw

27.10.2023  14:23    <DIR>          .
27.10.2023  14:23    <DIR>          ..
               0 файлов              0 байт
               2 папок  977 389 416 448 байт свободно

D:\Download\ajdhjfkwofnwdiowdkncionioweudnmnspcjwpjedpjqpsdmpqlmsdpmnohfoqpwdsmnondoqhodhoq\kmedfopqmpsmxcopmndcoibnoqwdqpmsdcppxinqionwedonqpwdmpmpmpqnowidiqdnpmnqpwdpqnw\mcwmnediqncniqnwondonqnwdpqjwodjpqjwddiondnnq23ejnwqdnqowjdndxnqowndioqnwid\qknmwdqinwod89wndkqn892dnkqnd89qhd8qwndilqndqw89dhqonwdnqklnwdlq8wjhdqwdklmnqiw>

После выполнения:

D:\Download\ajdhjfkwofnwdiowdkncionioweudnmnspcjwpjedpjqpsdmpqlmsdpmnohfoqpwdsmnondoqhodhoq\kmedfopqmpsmxcopmndcoibnoqwdqpmsdcppxinqionwedonqpwdmpmpmpqnowidiqdnpmnqpwdpqnw\mcwmnediqncniqnwondonqnwdpqjwodjpqjwddiondnnq23ejnwqdnqowjdndxnqowndioqnwid\qknmwdqinwod89wndkqn892dnkqnd89qhd8qwndilqndqw89dhqonwdnqklnwdlq8wjhdqwdklmnqiw>dir
 Том в устройстве D имеет метку XXXX
 Серийный номер тома: XXXX-XXXX

 Содержимое папки D:\Download\ajdhjfkwofnwdiowdkncionioweudnmnspcjwpjedpjqpsdmpqlmsdpmnohfoqpwdsmnondoqhodhoq\kmedfopqmpsmxcopmndcoibnoqwdqpmsdcppxinqionwedonqpwdmpmpmpqnowidiqdnpmnqpwdpqnw\mcwmnediqncniqnwondonqnwdpqjwodjpqjwddiondnnq23ejnwqdnqowjdndxnqowndioqnwid\qknmwdqinwod89wndkqn892dnkqnd89qhd8qwndilqndqw89dhqonwdnqklnwdlq8wjhdqwdklmnqiw

27.10.2023  14:26    <DIR>          .
27.10.2023  14:26    <DIR>          ..
04.05.2022  19:40            21 674 destination.ext
               1 файлов         21 674 байт
               2 папок  977 389 391 872 байт свободно

D:\Download\ajdhjfkwofnwdiowdkncionioweudnmnspcjwpjedpjqpsdmpqlmsdpmnohfoqpwdsmnondoqhodhoq\kmedfopqmpsmxcopmndcoibnoqwdqpmsdcppxinqionwedonqpwdmpmpmpqnowidiqdnpmnqpwdpqnw\mcwmnediqncniqnwondonqnwdpqjwodjpqjwddiondnnq23ejnwqdnqowjdndxnqowndioqnwid\qknmwdqinwod89wndkqn892dnkqnd89qhd8qwndilqndqw89dhqonwdnqklnwdlq8wjhdqwdklmnqiw>

Код возврата 0 (успех). Поведение соответствует документации.

Kutush Oct 29 2023 at 18:17

Работает!

Я так понимаю, надо было грамотно определить функцию:

Private Declare PtrSafe Function CopyFile Lib "kernel32" Alias "CopyFileW"...

Спасибо, буду пользоваться.

Добавил ваш код в статью, надеюсь вы не против?

Может быть вы подскажете как добавить в коде проверку существования целевой папки и если её нет - создать её.

Kutush Oct 27 2023 at 00:38

sDir, dDir, old_name будут описаны как Variant

Действительно, спасибо, поправил скрипт.

belch84 Oct 25 2023 at 11:02

Когда-то очень давно решал в чем-то похожую задачу для FoxPro for DOS. Необходимо было обеспечить работу с файлами, имеющими длинные имена для приложения, которое понимало только короткие имена файлов в формате 8.3 (максимум 8 символов на имя и 3 на расширение имени, для имен папок тоже). Для совместимости в файловых системах тех времен (FAT32 или NTFS) поддерживались одновременно длинное и короткое имена файла (не знаю, как обстоит дело сейчас). Идея состояла в том, чтобы определять короткое имя по длинному и наоборот при помощи MS-DOS команды DIR. При соответствующих параметрах эта команда для заданного файла выдает его длинное и короткое имена, которые можно записать во временный файл, а затем извлечь из него

Код программы на языке FoxPro (очень похожем на BASIC)

* set talk off
* S = fnm_cnv('H:\Накладные_вход', .T.)
* S = fnm_cnv('H:\_1905~1')
* ?S
* fnm_cnv('C:\USER1\EXP_DPA\temp3dasjdajsd\',.T.)

FUNCTION fnm_cnv
PARAMETER m.fnm, m.src_long
* преобразование длинных имен файлов в короткие и наоборот
  PRIVATE S, is_long
  
  is_long = type('m.src_long') = 'L' and m.src_long
  IF getenv('OS') = 'Windows_NT'
    S = getnm_NT(m.fnm, m.is_long)
  ELSE
    S = getnm_98(m.fnm, m.is_long)
  ENDIF
RETURN S

FUNCTION getnm_NT
PARAMETER m.fnm, m.src_long
* преобразование длинного имени файла в короткое или наоборот
* fnm       - исходное имя файла
* src_long - ИСТИНА для преобразования длинного в короткое,
*            не задано или ЛОЖЬ для обратного пр-ния
* Исходное имя должно быть задано с полным путем!
  
  IF type('UDir') # 'C'
    PRIVATE UDir
    UDir = ''
  ENDIF
  
  PRIVATE src_nm, tmp_nm, bat_nm, h, I, S, p1, ;
          p2, OS_NT, cur_dir, cur_nm, long_nm, short_nm, drv, ;
          is_dir, success, long2short, result
  tmp_nm = UDir + '__tmp__.txt'
  bat_nm = UDir + 'longdir.bat'
  result = ''
  success = .F.
  
  OS_NT = (getenv('OS') = 'Windows_NT')
  long2short = type('m.src_long') = 'L' and m.src_long
  
  DIMENSION tmp_arr[1]
  
  IF not m.OS_NT
    WAIT WINDOW 'GETNM_NT: неверная версия операционной системы'
    RETURN m.result
  ENDIF
  
  src_nm = alltrim(m.fnm)
  IF at(':\', m.src_nm) = 0
    WAIT WINDOW 'GETNM_NT: неверный полный путь для файла' + chr(13) + ;
                m.src_nm
    RETURN m.result
  ENDIF
  drv = left(m.src_nm,3)
  
  IF not m.long2short and not file(m.src_nm)
    result = ''
    RETURN m.result
  ENDIF
  
  * обрабатываем полный путь к файлу последовательно
  FOR I = 1 TO 999
  
    * определяем, является ли текущий элемент именем 
    * оглавления или файла
    p1 = at('\',m.src_nm, I+1)
    is_dir = (p1 > 0)
    
    * выделяем для текущего элемента его имя и имя оглавления,
    * в котором он содержится
    p2 = at('\', m.src_nm, I)
    cur_dir = left(m.src_nm, p2)
    IF m.is_dir
      cur_nm = substr(m.src_nm,p2+1,p1-p2-1)
    ELSE
      cur_nm = substr(m.src_nm, p2 + 1)
    ENDIF
    
    * с помощью команды DIR формируем текстовый файл,
    * в котором содержатся длинное и короткое имена тек.элемента
  
    * создаем временный BAT-файл для запуска
    ERASE (bat_nm)
    h = fcreate(bat_nm)
    = fputs(h, '@echo off')
    IF m.is_dir
      = fputs(h, 'DIR ' + m.cur_dir + '*.*' + ' /X /D >' + m.tmp_nm)
    ELSE 
      = fputs(h, 'DIR ' + m.cur_dir + ' /X >' + m.tmp_nm)
    ENDIF
    = fclose(h)
  
    * выполняем BAT-файл и формирем текстовый файл с результатом DIR
    ERASE (m.tmp_nm)
    RUN cmd /c &bat_nm
    
    IF not file(m.tmp_nm)
      WAIT WINDOW 'Ошибка при создании файла, содержащего длинные имена'
      result = ''
      RETURN m.result
    ENDIF
    
    * удаляем BAT-файл
    ERASE (bat_nm)
    
    * открываем файл с результатми для анализа
    h = fopen(m.tmp_nm)
    
    * если первая строка пустая - пропускаем ее
    S = fgets(h,512)
    IF empty(S)
      S = fgets(h,512)
    ENDIF
    
    * если в текущей строке инф. о томе - пропускаем ее
    IF not feof(h) and ;
       ('том в устройстве' $ lower(S) or 'volume in drive' $ lower(S))
      S = fgets(h,512)
    ENDIF
    
    * если в текущей строке серийный номер тома - пропускаем ее
    IF not feof(h) and ;
       ('серийный номер тома' $ lower(S) or 'volume serial number' $ lower(S))
      S = fgets(h,512)
    ENDIF
    
    * если текущая строка пустая - пропускаем ее
    IF empty(S)
      S = fgets(h,512)
    ENDIF
    
    * пропускаем имя текущего оглавления
    IF not feof(h) 
      S = fgets(h,512)
    ENDIF

    * отыскиваем текущий элемент в файле с результатами DIR и 
    * преобразуем его нужным способом
    success = .F.
    DO WHILE not feof(h) and not success
      S = fgets(h, 512)
      IF empty(left(S,12)) or empty(substr(S,50))
        LOOP
      ENDIF
    
      short_nm = trim(substr(S,37,12))
      long_nm = trim(substr(S, 50))
      
      IF not m.long2short
        success = (upper(m.cur_nm) == upper(m.long_nm)) or ;
                  (upper(m.cur_nm) == upper(m.short_nm))
      ELSE
        * длинное имя в короткое
        success = (upper(m.cur_nm) == upper(m.long_nm))
      ENDIF
    ENDDO
  
    = fclose(h)
    ERASE (m.tmp_nm)
  
    IF not m.success
      EXIT
    ENDIF
    
    IF not m.long2short
      result = m.result + m.long_nm
    ELSE
      IF not empty(m.short_nm)
        result = m.result + m.short_nm
      ELSE
        result = m.result + m.long_nm
      ENDIF
    ENDIF
    
    IF m.is_dir
      result = m.result + '\'
    ENDIF
    
    IF not m.is_dir
      EXIT
    ENDIF
      
  ENDFOR

  IF m.success and not empty(m.result)
    result = m.drv + m.result
  ENDIF
 
RETURN m.result

FUNCTION getnm_98
PARAMETER m.fnm, m.src_long
* преобразование длинного имени файла в короткое или наоборот
* fnm       - исходное имя файла
* src_long - ИСТИНА для преобразования длинного в короткое,
*            не задано или ЛОЖЬ для обратного пр-ния
* Исходное имя должно быть задано с полным путем!
  
  IF type('UDir') # 'C'
    PRIVATE UDir
    UDir = ''
  ENDIF
  
  PRIVATE src_nm, tmp_nm, bat_nm, h, I, S, p1, ;
          p2, OS_NT, cur_dir, cur_nm, long_nm, short_nm, drv, ;
          is_dir, success, long2short, result
  tmp_nm = UDir + '__tmp__.txt'
  bat_nm = UDir + 'longdir.bat'
  result = ''
  success = .F.
  
  OS_NT = (getenv('OS') = 'Windows_NT')
  long2short = type('m.src_long') = 'L' and m.src_long
  
  DIMENSION tmp_arr[1]
  
  IF m.OS_NT
    WAIT WINDOW 'GETNM_98: неверная версия операционной системы'
    RETURN m.result
  ENDIF
  
  src_nm = alltrim(m.fnm)
  IF at(':\', m.src_nm) = 0
    WAIT WINDOW 'GETNM_98: неверный полный путь для файла' + chr(13) + ;
                m.src_nm
    RETURN m.result
  ENDIF
  drv = left(m.src_nm,3)
  
  IF not m.long2short and not file(m.src_nm)
    result = ''
    RETURN m.result
  ENDIF
  
  * обрабатываем полный путь к файлу последовательно
  FOR I = 1 TO 999
  
    * определяем, является ли текущий элемент именем 
    * оглавления или файла
    p1 = at('\',m.src_nm, I+1)
    is_dir = (p1 > 0)
    
    * выделяем для текущего элемента его имя и имя оглавления,
    * в котором он содержится
    p2 = at('\', m.src_nm, I)
    cur_dir = left(m.src_nm, p2)
    IF m.is_dir
      cur_nm = substr(m.src_nm,p2+1,p1-p2-1)
    ELSE
      cur_nm = substr(m.src_nm, p2 + 1)
    ENDIF
    
    * с помощью команды DIR формируем текстовый файл,
    * в котором содержатся длинное и короткое имена тек.элемента
  
    * создаем временный BAT-файл для запуска
    ERASE (bat_nm)
    h = fcreate(bat_nm)
    = fputs(h, '@echo off')
    IF m.is_dir
      = fputs(h, 'DIR "' + m.cur_dir + '*.*' + '" >' + m.tmp_nm)
    ELSE 
      = fputs(h, 'DIR "' + m.cur_dir + '" >' + m.tmp_nm)
    ENDIF
    = fclose(h)
  
    * выполняем BAT-файл и формирем текстовый файл с результатом DIR
    RUN &bat_nm
    
    IF not file(m.tmp_nm)
      WAIT WINDOW 'Ошибка при создании файла, содержащего длинные имена'
      RETURN 0
    ENDIF
    
    * удаляем BAT-файл
    ERASE (bat_nm)
    
    * открываем файл с результатми для анализа
    h = fopen(m.tmp_nm)
    
    * если первая строка пустая - пропускаем ее
    S = fgets(h,512)
    IF empty(S)
      S = fgets(h,512)
    ENDIF
    
    * если в текущей строке инф. о томе - пропускаем ее
    IF not feof(h) and ;
       ('том в устройстве' $ lower(S) or 'volume in drive' $ lower(S))
      S = fgets(h,512)
    ENDIF
    
    * если в текущей строке серийный номер тома - пропускаем ее
    IF not feof(h) and ;
       ('серийный номер тома' $ lower(S) or 'volume serial number' $ lower(S))
      S = fgets(h,512)
    ENDIF
    
    * если текущая строка пустая - пропускаем ее
    IF empty(S)
      S = fgets(h,512)
    ENDIF
    
    * пропускаем имя текущего оглавления
    IF not feof(h) 
      S = fgets(h,512)
    ENDIF

    * если текущая строка пустая - пропускаем ее
    IF empty(S)
      S = fgets(h,512)
    ENDIF
    
    * отыскиваем текущий элемент в файле с результатами DIR и 
    * преобразуем его нужным способом
    success = .F.
    DO WHILE not feof(h) and not success
      S = fgets(h, 512)
      IF empty(left(S,12)) or empty(substr(S,45))
        LOOP
      ENDIF
    
      short_nm = left(S, 12)
      IF not empty(right(m.short_nm,3))
        short_nm = trim(left(m.short_nm,8)) + '.' + right(m.short_nm,3)
      ELSE
        short_nm = trim(left(m.short_nm,8))
      ENDIF
      short_nm = trim(m.short_nm)
      
      long_nm = trim(substr(S, 45))
      
      IF not m.long2short
        success = (upper(m.cur_nm) == upper(m.long_nm)) or ;
                  (upper(m.cur_nm) == upper(m.short_nm))
      ELSE
        * длинное имя в короткое
        IF empty(m.short_nm)
          success = (upper(m.cur_nm) == upper(m.long_nm))
        ELSE         
          success = (upper(m.cur_nm) == upper(m.short_nm))
        ENDIF
      ENDIF
    ENDDO
  
    = fclose(h)
    ERASE (m.tmp_nm)
  
    IF not m.success
      EXIT
    ENDIF
    
    IF not m.long2short
      result = m.result + m.long_nm
    ELSE
      IF not empty(m.short_nm)
        result = m.result + m.short_nm
      ELSE
        result = m.result + m.long_nm
      ENDIF
    ENDIF

    
    IF m.is_dir
      result = m.result + '\'
    ENDIF
    
    IF not m.is_dir
      EXIT
    ENDIF
      
  ENDFOR

  IF m.success and not empty(m.result)
    result = m.drv + m.result
  ENDIF
  
RETURN m.result

Программа работала под Windows 98 и Windows XP, для них способ конвертации имен несколько отличался.

Точно так же можно было бы организовать переименование файлов с длинными именами, используя команду RENAME, или копирование файлов (команда COPY)

IDDQDesnik Oct 25 2023 at 14:02

Создание имен 8.3 сейчас много где выключено по соображения производительности. Проверить можно выполнив от Администратора: fsutil 8dot3name query C:

Show the best of all time