VBA中的短路径

我有这个递归文件列表脚本，它像一个魅力。但是只要文件路径变得太长，就会引发path wasn't found错误。VBA中的短路径

所以我必须用某种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

来源

2017-08-31 Lukas Tilch

我解决了这个问题。

这就需要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)

来源

2017-09-04 09:42:47

VBA中的短路径

回答

相关问题