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中的短路徑

回答

相關問題