VB复制整个磁盘下的文件，包括子文件夹，不要调用CMD命令

Question

最好可以调用API函数，要能够判断复制是否成功，不要调用批处理和一些除VB本身代码之外的。
没看明白的就不用回答了，代码拖拖拉拉一大堆的也不用回答了，150分诚心寻求VB高手回答问题（剩下的50分我满意再加）。在线等半小时

Answer 1

在VB代码输入区复制下面代码，运行即可。

Option Explicit
Dim SrcFolder As String, DstFolder As String, FileName As String, S As String
Dim fs, folder, subfolders, Files, File, i, j

Public Function CreateDirectory(ByVal strPath As String) As Boolean
Dim i As Integer
Dim CurrentDir As String

On Error GoTo err

Dim strT() As String

If Dir(strPath, vbDirectory) <> "" Then
'如果目录存在,直接返回

CreateDirectory = True

Exit Function

End If

If Dir(strPath) <> "" Then Exit Function

If Right(strPath, 1) = "\\" Then
'去掉最右边的""

strPath = Left(strPath, Len(strPath) - 1)

End If

If InStr(strPath, "\\") = 0 Then Exit Function
'无子目录

strT = Split(strPath, "\\")

CurrentDir = strT(0)

For i = 1 To UBound(strT)

If Dir(CurrentDir & "\\" & strT(i), vbDirectory) = "" Then

MkDir CurrentDir & "\\" & strT(i)

CurrentDir = CurrentDir & "\\" & strT(i)

End If

Next

CreateDirectory = True

Exit Function
err:

'此处如果出错，很有可能就是目录名中包含了系统不支持的字符，比如说* / & 等
End Function

Function digui(path)

Set folder = fs.GetFolder(path)

Set subfolders = folder.subfolders

Set Files = folder.Files

For Each i In Files

If InStr(1, i.Name, FileName, 1) Then '如果发现符合特征的文件

S = Mid(i.path, InStr(i.path, "\\"))

S = Left(S, InStrRev(S, i.Name, , vbTextCompare) - 1)

If Right(S, 1) = "\\" Then S = Left(S, Len(S) - 1)

S = DstFolder & S

CreateDirectory S

FileCopy i.path, S & "\\" & i.Name '则复制

End If

DoEvents

Next

For Each j In subfolders

digui (j.path)

DoEvents

Next
End Function

Private Sub Form_Load()

SrcFolder = InputBox("请输入源盘", "第1步", "D:")

If SrcFolder = "" Then End

DstFolder = InputBox("请输入目标盘", "第2步", "E:")

If DstFolder = "" Then End

If Right(DstFolder, 1) = "\\" Then DstFolder = Left(DstFolder, Len(DstFolder) - 1)

FileName = InputBox("请输入文件名特征", "第3步", ".Mp3")

If FileName = "" Then End

FileName = Replace(FileName, "*", "")

Set fs = CreateObject("scripting.filesystemobject")

digui (SrcFolder)

MsgBox "文件复制结束！", vbInformation, "恭喜你"

End
End Sub