VBA中的短路径

我有一个递归文件列表脚本，它的工作方式很有魅力。 但是一旦文件路径变得太长，它就会抛出一个错误，

路径找不到

因此，我不得不用VBA和一些google'ing来缩短路径，我发现我可以在

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

我解决了这个问题

这需要在调用main sub中的

RecursiveFolder

函数之前进行

    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)

我解决了这个问题

这需要在调用main sub中的

RecursiveFolder

函数之前进行

    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)