Excel VBA 長すぎて扱えないファイルパスをショートパスに変換する

## はじめに
Windowsでは、ファイルパスが長すぎると(260文字以上？)、ファイル操作ができなくなる。
VBAでも同様で、ファイルパスが長すぎると、ファイル操作ができない。
そのため、ファイルパスをショートパスに変更し、扱えるようにしたい。

## マクロ作成の経緯
File System Objectを使い、サブフォルダを含むフォルダ内のファイルを一括取得していた。
すると、フォルダ階層が深く、ファイルパスが長くなり、取得できないファイルがあった。
この長すぎるファイルパスにも対応する方法を模索した。

## 作成したマクロの概要
文字制限にひっかからないフォルダをショートパスに変換する方法を参考に作成した。
存在するフォルダまでフォルダ階層をさかのぼり、そのパスをショートパスに変換する。
変換したショートパスとその後ろ側のパスを繋げることで、扱えるパスに変換する。
これらの動作を実行する、Functionプロシージャを作成した。

### 動作手順
1. 存在するフォルダになるまで、パスの最終要素を順番に切り取る
1. 切り取ったパスの最終要素は後ろ側のパスとして、繋げて記録しておく
1. 存在するフォルダを見つけたら、そのフォルダをショートパスに変換する
（存在するフォルダを見つけられなかった場合、そのパスは存在しない）
1. 変換したフォルダのショートパスと、記録しておいた後ろ側のパスを繋げる
（後ろ側のパスが間違っている可能性があるので、完成したパスが存在するか確認する）

## 完成したマクロ
### ショートパスに変換するFunctionプロシージャ
```VB:ChangeShortPath
Public Function ChangeShortPath(FullPath As String) As String

Dim Fso As Object
Dim TargetPath As String
Dim LastPath As String
Dim i As Long

    Set Fso = CreateObject("Scripting.FileSystemObject")   
    TargetPath = FullPath

    Do Until Fso.FolderExists(TargetPath) 
        
        LastPath = "\" & Fso.GetFileName(TargetPath) & LastPath
        TargetPath = Fso.GetParentFolderName(TargetPath)
        
        If TargetPath = "" Then
            MsgBox "指定されたフォルダは存在しません。"
            End 
        End If   
    Loop
    
    TargetPath = Fso.GetFolder(TargetPath).ShortPath & LastPath

     If Fso.FileExists(TargetPath) = False _
        And Fso.FolderExists(TargetPath) = False Then
        
        MsgBox "指定されたパスは存在しません。"
        End
        
    End If
    
    Set Fso = Nothing
     
    ChangeShortPath = TargetPath
    
End Function
```

#### File System Objectの各メソッドの注釈
- File System Objectの「FolderExists」は、長すぎて扱えないパスの場合、Falseを返す
また、ファイルパスの場合、フォルダではないので、Falseを返す
- File System Objectの「GetFileName」は、ファイル名に限らず、最終要素を取り出す
（ファイルパスではファイル名を、フォルダパスでは最終要素のフォルダを返す）
- File System Objectの「GetParentFolderName」は最終要素のひとつ前の要素を取り出す
（フォルダパスでは親フォルダを、ファイルパスではファイルのあるフォルダを返す）
- 上記の特徴を活かし、ファイルパス・フォルダパスの両方に対応したマクロとなっている
　

### 使用例
使用例として、サブフォルダを含むフォルダ内のファイル一覧を作成するマクロを記載。

#### 出力シートイメージ
![スクリーンショット 2024-10-31 115557.jpg](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/3917113/12fb3e7f-d1be-6cca-4275-2ef70c929c72.jpeg)

#### 作成コード
```VB:使用例
Public Sub SearchSubFolders_File()
Dim FolderPath As String
Dim StartRow As Long
Dim FolderStartColumn As Long

    With ActiveSheet
        .Range("A1").CurrentRegion.Offset(2).ClearContents
        FolderPath = .Range("B1").Value
        StartRow = .Range("A3").Row
        FolderStartColumn = .Range("C3").Column
    End With
    
    Call FileSearch(FolderPath, StartRow, FolderStartColumn, FolderStartColumn)
    
End Sub


Sub FileSearch(FolderPath As String, outRow As Long, outColumn As Long, baseColumn As Long)
Dim Fso As Object
Dim f As Object
Dim i As Long
Dim iFolder As Object
Dim OriginalPath As String
Dim CurrentFolderPath As String

    Set Fso = CreateObject("Scripting.FileSystemObject")
    OriginalPath = FolderPath '短くする前のパスを取っておく
    Set iFolder = Fso.GetFolder(ChangeShortPath(FolderPath)) 'フォルダ操作はショートパスで行う
    
    For Each f In iFolder.SubFolders
        '再帰呼出
        Call FileSearch(OriginalPath & "\" & f.Name, outRow, outColumn + 1, baseColumn) 
    Next
        
    With ActiveSheet 
        For Each f In iFolder.Files
            CurrentFolderPath = OriginalPath    
            
            For i = outColumn To baseColumn Step -1
                .Cells(outRow, i).Value = Fso.GetBaseName(CurrentFolderPath)
                CurrentFolderPath = Fso.GetParentFolderName(CurrentFolderPath)
            Next i
            
            .Cells(outRow, 1) = OriginalPath & "\" & f.Name
            .Cells(outRow, 2) = f.Name      
            outRow = outRow + 1     
        Next f
  
    End With

    Set Fso = Nothing

End Sub
```
サンプルファイル保存先：

https://github.com/rie1234k/ExcelVBA_Tips/tree/master/FileNameConvert

## 参考
- [パスが長すぎてファイルの移動ができない時の対応方法(Excel マクロ(VBA) )｜ちまき](https://note.com/chimaki/n/n440a8e7c34ee "パスが長すぎてファイルの移動ができない時の対応方法(Excel マクロ(VBA) )｜ちまき")
- [VBAで長いパスが扱えないと思ったら - knjnameのブログ](https://knjname.hateblo.jp/entry/2015/01/27/220219 "VBAで長いパスが扱えないと思ったら - knjnameのブログ")