1

我对所有文件和子文件夹进行了递归搜索，但我想在另一个目录中创建确切的文件夹结构。

对此的任何帮助将不胜感激，我自己尝试过这样做以及在网上查看，但我还没有找到任何东西。

所以我希望在 SaveDir 位置重新创建来自 ConvertDir 的文件夹结构，没有任何文件。我也希望在发现它们的同时创建它们，但我不知道这是否可能或明智。

这将在 SaveDir 的顶层创建不在正确位置的文件夹。

这是我的代码的副本：

On Error Resume Next

    Dim ObjFolder
    Dim ObjSubFolders
    Dim ObjSubFolder
    Dim ObjFiles
    Dim ObjFile
    Dim objFileSecuritySettings
    Dim intRetVal
    Dim objSD
    Dim objFolderSecuritySettings

    ObjFolder = FSO.GetFolder(FolderName)
    ObjFiles = ObjFolder.Files

    For Each ObjFile In ObjFiles  'Write all files to output files

        objFileSecuritySettings = _
        objWMIService.Get("Win32_LogicalFileSecuritySetting='" & ObjFile.Path & "'")
        intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)

        If intRetVal = 0 Then

            ObjOutFile.WriteLine(ObjFile.Path) ' write in CSV format

        End If

    Next

    ObjSubFolders = ObjFolder.SubFolders     'Getting all subfolders

    For Each ObjFolder In ObjSubFolders

        objFolderSecuritySettings = _
        objWMIService.Get("Win32_LogicalFileSecuritySetting='" & ObjFile.Path & "'")
        intRetVal = objFolderSecuritySettings.GetSecurityDescriptor(objSD)
        Directory.CreateDirectory(SaveDir + "\\" + ObjFolder.name)

        If intRetVal = 0 Then

            ObjOutFile.WriteLine(ObjFolder.Path) ' write in CSV format
            ObjOutFile.WriteLine(ObjFolder.ObjSubFolders)

        End If

        Gather(ObjFolder.Path)

    Next

先感谢您。

安东斯克

4

2 回答 2

2

您可以使该方法传递它开始的根文件夹以保持目录树完整。并像这样使用它：

ReCreateDirectoryStructure("C:\somefolder\", "D:\")

Private Sub ReCreateDirectoryStructure(ByVal sourceDir As String, _
        ByVal targetDir As String, Optional ByVal rootDir As String = "")
    If rootDir = String.Empty Then
        rootDir = sourceDir
    End If
    Dim folders() As String = IO.Directory.GetDirectories(sourceDir)
    For Each folder As String In folders
        Directory.CreateDirectory(folder.Replace(rootDir, targetDir))
        ReCreateDirectoryStructure(folder, targetDir, rootDir)
    Next
End Sub
于 2013-08-29T08:20:06.133 回答
0

确保使用以下代码导入所需的命名空间。

Imports System
Imports System.IO
Imports System.Text
Imports System.Text.RegularExpressions

导入上述命名空间后，可以使用以下函数在目标目录中创建源目录的结构。

 ''' <summary>
    ''' Recreates a directories structure in another directory
    ''' </summary>
    ''' <param name="destinationRoot">The destination directory in which the structure of the source directory will be created.</param>
    ''' <param name="sourceRoot">The root directory of the source directory which will be the basis for creating the directory tree</param>
    ''' <param name="sourceDIR">The directory whose structure will be created in the destination root directory</param>
    ''' <returns></returns>
    Public Shared Function RecreateDirectoryStructure(ByVal destinationRoot As String,
                                               ByVal sourceRoot As String,
                                               ByVal sourceDIR As String) As String
        Dim cOk As Boolean = True, ERR As Boolean = False
        Dim lg1 As Integer = 0, lg2 As Integer = 0
        Dim root As String = Nothing
        If sourceRoot IsNot Nothing Then
            lg1 = sourceRoot.Length
        End If
        If sourceDIR IsNot Nothing Then
            lg2 = sourceDIR.Length
        End If
        Dim subPath As String = Nothing
        If lg1 >= 1 And lg2 > 1 Then
            Dim sub2 As String = sourceDIR.Substring(0, lg1)
            If sub2 IsNot Nothing AndAlso sourceRoot IsNot Nothing Then
                If sub2.ToLower = sourceRoot.ToLower And (lg2 - 1) >= lg1 Then
                    subPath = sourceDIR.Substring(lg1, lg2 - lg1)
                End If
            End If
        End If
        If subPath Is Nothing Then
            subPath = sourceDIR
        End If
        Dim fdp As String = destinationRoot
        Dim splitPat As String = Nothing 'the regex pattern used for splitting the directory full path
        Dim pathSplitter As String = CStr(System.IO.Path.DirectorySeparatorChar)
        If pathSplitter = "\" Then
            splitPat = "\\"
        ElseIf pathSplitter = "/" Then
            splitPat = "/"
        Else
            Stop
            cOk = False
            'error
            'Unkown path separator. Define a custom regex pattern here
        End If
        Dim subs() As String = Nothing
        If subPath IsNot Nothing AndAlso subPath <> "" AndAlso splitPat IsNot Nothing Then
            subs = SplitText(subPath, splitPat)
        End If
        If subs IsNot Nothing AndAlso cOk Then
            For j As Integer = 0 To UBound(subs) Step +1
                Dim s As String = subs(j)
                If s IsNot Nothing AndAlso s <> "" Then 'directory name cannot be of zero length
                    fdp = System.IO.Path.Combine(fdp, s)
                    If Not My.Computer.FileSystem.DirectoryExists(fdp) Then
                        My.Computer.FileSystem.CreateDirectory(fdp) ' if directory does not exist, create it
                        If Not My.Computer.FileSystem.DirectoryExists(fdp) Then
                            ERR = True
                            Exit For
                        End If
                    End If
                End If
            Next
        End If
        If Not cOk Then
            MessageBox.Show("An error has occured.")
        End If
        If ERR Then
            MessageBox.Show("Error: Directory could not be created. " & vbCrLf & fdp)
        End If
        Return fdp
    End Function



Public Shared Function SplitText(ByVal StringSubject As String,
                        ByVal DelimiterRegexPattern As String) As System.String()
    Dim myText As String
    Dim C() As String, TextSplits() As String = Nothing
    If StringSubject IsNot Nothing Then
        If StringSubject IsNot Nothing Then
            myText = StringSubject
            C = Regex.Split(myText, DelimiterRegexPattern)
        End If
    End If
    Return C
End Function

以下是如何使用该功能的示例。

Dim srcRootDir as String = "C:\SDir1\SDir2\SDir3"
Dim dstRootDir as String = "C:\DDir"
Dim newDIR as String = "C:\SDir1\SDir2\SDir3\SDir4\SDir5\SDir6\SDir7"

Dim NewPath As String =    RecreateDirectoryStructure(dstRootDir , srcRootDir , newDIR )
于 2021-11-16T14:07:16.003 回答