Gar*_*ans 7 excel vba filesystemobject fso
我正在使用Microsoft Scripting Runtime(FSO)解析文件夹并生成所有内容的列表,文件夹在网络上,结果路径最终超过260.我的最小代码如下: -
Private Sub ProcessFolder(ByVal StrFolder As String)
Dim Fl              As File
Dim Fldr            As Folder
Dim RootFldr        As Folder
Set RootFldr = FS.GetFolder(StrFolder)
    For Each Fl In RootFldr.Files
        Debug.Print Fl.Path
    Next
    For Each Fldr In RootFldr.SubFolders
        DoEvents
        ProcessFolder Fldr.Path
    Next
Set RootFldr = nothing    
End sub
在某个级别StrFolder长度变为259,Set RootFldr ...文件夹行工作但是For Each Fl In RootFldr.Files给出了错误76: Path not found,可能是因为内容导致路径突破260限制.
查看Windows资源管理器时,文件夹中有文件.我正在使用Excel作为此代码的主机,因为我将结果输出到工作簿.
为了清楚地了解我的问题及其背景,我需要使用FSO(很高兴能够显示替代品,如果它们存在)来访问网络路径深度超过260个字符的文件.我需要它作为FSO,因为我的工具是获取文件夹路径和文件路径,名称,大小创建和修改.
Han*_*ant 10
将MAXFILE加密的DOS路径名转换为本机OS路径名的技术已经很好地建立并记录在案.总结:
\\?\,例如\\?\C:\foo\bar\baz.txt'\\?\UNC\,例如\\?\UNC\server\share\baz.txt.也适用于FileSystemObject,至少在我在Windows 10上测试你的代码时.在旧的Windows版本或服务器上的网络重定向器中可能不一定如此.通过使用FAR文件管理器来创建具有长名称的子目录并通过以下方式验证:
Dim path = "\\?\C:\temp\LongNameTest"
ProcessFolder path
制作:
\\?\c:\temp\LongNameTest\VeryLongFolderName0123456789012345678901234567890123456789012345678901234567890123456789\VeryLongFolderName0123456789012345678901234567890123456789012345678901234567890123456789\VeryLongFolderName0123456789012345678901234567890123456789012345678901234567890123456789\VeryLongFolderName0123456789012345678901234567890123456789012345678901234567890123456789\VeryLongFolderName0123456789012345678901234567890123456789012345678901234567890123456789\Chrysanthemum.jpg
这是488个字符长.要记住的事情:
这需要一些创造性的编码,但使用ShortPath就是答案。
该工具用于创建根文件夹中每个文件夹和文件的列表,文件还显示其大小以及创建/修改日期。问题是,当文件或文件夹的最终路径超过 260 时,就会Error 76: Path Not Found引发错误,并且代码将无法捕获该区域的内容。
使用 Microsoft Scripting Runtime (FSO)ShortPath可以解决这个问题,但路径从人类可读到编码:-
完整路径
\\ServerName00000\Root_Root_contentmanagement\DPT\STANDARDS_GUIDELINES\VENDOR_CERTIFICATION_FILES\PDFX_CERTIFICATION_ALL\2006_2007\DPT\CompantName0\Approved\Quark\India under Colonial Rule_structure sample\058231738X\Douglas M. Peers_01_058231738X\SUPPORT\ADDITIONAL INFORMATION\IUC-XTG & XML file
短路径
\\lo3uppesaapp001\pesa_cmcoe_contentmanagement\CTS\S4SJ05~5\V275SE~8\PDM5D9~G\2N52EQ~5\HPE\GS9C6L~U\Approved\Quark\IQPSJ5~F\0CWHH1~G\DOFNHA~8\SUPPORT\A6NO7S~K\IUC-XTG & XML file
(注意我已经更改了完整路径以保护 IP 和公司信息,但大小是相同的)
您可以看到,虽然我可以将短路径传递给某人,他们可以将其放入 Windows 资源管理器中以到达那里,但他们只需查看就知道它去了哪里,为了解决这个问题,使用了一个全局变量,该变量将文件夹路径保留为完整的字符串并遵循短路径正在做的事情。这个字符串就是我输出给用户的内容。下面的代码被删减,但显示了我是如何实现它的。
简短的回答是,ShortPathFSO 会解决这个问题,但道路不会平坦。
Dim FS              As New FileSystemObject
Dim LngRow          As Long
Dim StrFolderPath   As String
Dim WkBk            As Excel.Workbook
Dim WkSht           As Excel.Worksheet
Public Sub Run_Master()
Set WkBk = Application.Workbooks.Add
    WkBk.SaveAs ThisWorkbook.Path & "\Data.xlsx"
    Set WkSht = WkBk.Worksheets(1)
        WkSht.Range("A1") = "Path"
        WkSht.Range("B1") = "File Name"
        WkSht.Range("C1") = "Size (KB)"
        WkSht.Range("D1") = "Created"
        WkSht.Range("E1") = "Modified"
        LngRow = 2
        Run "\\ServerName00000\AREA_DEPT0_TASK000"
    Set WkSht = Nothing
    WkBk.Close 1
Set WkBk = Nothing
MsgBox "Done!"
End Sub
Private Sub Run(ByVal StrVolumeToCheck As String)
Dim Fldr            As Folder
Dim Fldr2           As Folder
Set Fldr = FS.GetFolder(StrVolumeToCheck)
    'This is the variable that follows the full path name
    StrFolderPath = Fldr.Path
    WkSht.Range("A" & LngRow) = StrFolderPath
    LngRow = LngRow +1
    For Each Fldr2 In Fldr.SubFolders
        If (Left(Fldr2.Name, 1) <> ".") And (UCase(Trim(Fldr2.Name)) <> "LOST+FOUND") Then
            ProcessFolder Fldr2.Path
        End If
    Next
Set Fldr = Nothing
End Sub
Private Sub ProcessFolder(ByVal StrFolder As String)
'This is the one that will will be called recursively to list all files and folders
Dim Fls             As Files
Dim Fl              As File
Dim Fldrs           As Folders
Dim Fldr            As Folder
Dim RootFldr        As Folder
Set RootFldr = FS.GetFolder(StrFolder)
    If (RootFldr.Name <> "lost+found") And (Left(RootFldr.Name, 1) <> ".") Then
        'Add to my full folder path
        StrFolderPath = StrFolderPath & "\" & RootFldr.Name
        WkSht.Range("A" & LngRow) = StrFolderPath
        WkSht.Range("D1") = RootFldr.DateCreated
        WkSht.Range("E1") = RootFldr.DateLastModified
        Lngrow = LngRow + 1
        'This uses the short path to get the files in FSO
        Set Fls = FS.GetFolder(RootFldr.ShortPath).Files
            For Each Fl In Fls
                'This output our string variable of the path (i.e. not the short path)
                WkSht.Range("A" & LngRow) = StrFolderPath
                WkSht.Range("B" & LngRow) = Fl.Name
                WkSht.Range("C" & LngRow) = Fl.Size /1024 '(bytes to kilobytes)
                WkSht.Range("D" & LngRow) = Fl.DateCreated
                WkSht.Range("E" & LngRow) = Fl.DateLastModified
                LngRow = LngRow + 1
            Next
        Set Fls = Nothing
        'This uses the short path to get the sub-folders in FSO
        Set Fldrs = FS.GetFolder(RootFldr.ShortPath).SubFolders
            For Each Fldr In Fldrs
                'Recurse this Proc
                ProcessFolder Fldr.Path
                DoEvents
            Next
        Set Fldrs = Nothing
        'Now we have processed this folder, trim the folder name off of the string
        StrFolderPath = Left(StrFolderPath, Len(StrFolderPath) - Len(RootFldr.Name)+1)
    End If
Set RootFldr = Nothing
End Sub
如前所述,这是代码的删减版本,它可以帮助我举例说明用于突破此限制的方法。实际上,一旦我完成了它,看起来就很初级了。
| 归档时间: | 
 | 
| 查看次数: | 4451 次 | 
| 最近记录: |