VBAのショートパス

Question

私はこの魅力的なように動作する再帰的ファイルリストスクリプトを持っています。 しかし、ファイルパスが長くなりすぎるとすぐに、path wasn't foundというエラーがスローされます。

だから私はいくつかgoogle'ingとVBAを使用して何とかパスを短縮する必要がありましたFSOで.ShortPathを使用することがわかったが、私はどのようにコードのどの行を把握することはできません。

私が何を試しても、私にはエラーしかありません。

FSOのパスを短縮する別の方法がありますか？

Sub ListFiles() 

    'Declare the variables 
    Dim objFSO As Object 
    Dim objTopFolder As Object 
    Dim strTopFolderName As String 
    Dim cstrsave As String 
    cstrsave = "U:\" 

    'Insert the headers for Columns A through F 
    Range("A1").Value = "File Name" 
    Range("B1").Value = "File Size" 
    Range("C1").Value = "File Type" 
    Range("D1").Value = "Date Created" 
    Range("E1").Value = "Date Last Accessed" 
    Range("F1").Value = "Date Last Modified" 
    Range("G1").Value = "Path" 

    'Assign the top folder to a variable 
    'strTopFolderName = "U:\" 



    'Create an instance of the FileSystemObject 
    Set objFSO = CreateObject("Scripting.FileSystemObject") 

    'Get the top folder 
    Set objTopFolder = objFSO.GetFolder(strTopFolderName) 
    'objTopFolder = objTopFolder.ShortPath 

    'Call the RecursiveFolder routine 
    Call RecursiveFolder(objTopFolder, True) 
    Call export_stdList_in_json_format(cstrsave, FileName) 
    End Sub 


Sub RecursiveFolder(objFolder As Object, _ 
    IncludeSubFolders As Boolean) 'On Error Resume Next 
    'Declare the variables 
    Dim objFile As Object 
    Dim objSubFolder As Object 
    Dim NextRow As Long 

    MsgBox (onjFile) 
    'Find the next available row 
    NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1 

    'Loop through each file in the folder 
    For Each objFile In objFolder.Files 
     Cells(NextRow, "A").Value = objFile.Name 
     Cells(NextRow, "B").Value = objFile.Size 
     Cells(NextRow, "C").Value = objFile.Type 
     Cells(NextRow, "D").Value = objFile.DateCreated 
     Cells(NextRow, "E").Value = objFile.DateLastAccessed 
     Cells(NextRow, "F").Value = objFile.DateLastModified 
     Cells(NextRow, "G").Value = objFile.path 
     NextRow = NextRow + 1 
    Next objFile 

    'Loop through files in the subfolders 
    If IncludeSubFolders Then 
     For Each objSubFolder In objFolder.Subfolders 
      Call RecursiveFolder(objSubFolder, True) 
     Next objSubFolder 
    End If ende: 
End Sub 

Answer 1

私はこの問題を解決しました。

これは

s = objTopFolder.ShortPath 
    Set objTopFolder = objFSO.GetFolder(s) 

メインサブでRecursiveFolder関数の呼び出し前に行く必要があり、これは

Dim objFSO As Object 
    Set objFSO = CreateObject("Scripting.FileSystemObject") 
    'Shortpath 
    s = objFolder.ShortPath 
    Set objFolder = objFSO.GetFolder(s) 
    MsgBox (objFolder.path) 

RecursiveFolder機能に行く必要