确保使用以下代码导入所需的命名空间。
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 )