Question

我有这个递归文件列表脚本，就像一个魅力。但是一旦文件路径变得太长，它就会抛出path wasn't found。

的错误

所以我必须以某种方式缩短使用VBA和某些谷歌的路径我发现我可以在.ShortPath上使用FSO，但我无法弄清楚如何或在哪一行代码。

无论我尝试什么，我都只有错误。

还是有另一种方法可以缩短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

我解决了这个问题。

这需要在主子

中调用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)

VBA中的短路径

1 个答案: