Question

I have a recursive search for all files and subfolders, but I want to create the exact folder structure in another directory.

ay help with this would be greatly appreciated, i have attempted to do this myself as well as looking on the web but i haven't been able to find anything yet.

So i want the folder structure from ConvertDir to be recreated in the SaveDir location, with none of the files. Also I was hoping for these to be created at the same time as they are found, but i do not know if that is even possible or wise.

this will create the folders found on the top level of the SaveDir not in the correct place.

here is a copy of my code:

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

Thank you in advance.

AntonSK

Was it helpful?

Solution

You could make the method pass on the root folder that it started at to keep the directory tree intact. And use it as such:

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

OTHER TIPS

Make sure to import the required namespaces by using the following code.

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

After importing the above namespaces, you can use the following function to create the structure of the source directory in the destination directory.

 ''' <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

Below is an example of how you can use the 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 )
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top