拷贝文件夹（解决就给分）

Question

use SHFileOperation API
http://www.allapi.net/apilist/SHFileOperation.shtmlHow to Copy or Move an Entire Directory using the API
http://www.mvps.org/vbnet/index.html?code/shell/shfileopadv.htmUtilizing Windows SHFileOperation API, Advanced
http://www.mvps.org/vbnet/index.html?code/shell/shfileopadv.htm

Answer 1

the 代码 is too long to post here, open those links to get the code

Answer 2

Private Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Long
    hNameMappings As Long
    lpszProgressTitle As String
End Type
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FO_MOVE = &H1
Private Const FO_COPY = &H2
Private Const FO_DELETE = &H3
Private Const FO_RENAME = &H4
Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_SIMPLEPROGRESS = &H100
Private Function CopyFileX(Filename() As String, BeginPath As String, ToPath As String) As Boolean
Dim tmpInt As Integer
Dim tpFile As SHFILEOPSTRUCT
Dim tmpStr As String
Dim rc As Long
tmpStr = BeginPath & Filename(0)// Finename(0)放路径，剩下的放文件名
For tmpInt = 1 To UBound(Filename)
    tmpStr = tmpStr & Chr(0) & BeginPath & Filename(tmpInt)
Next
With tpFile
    .wFunc = FO_Copy
    .pFrom = tmpStr
    .pTo = ToPath & Chr(0) & Chr(0)
End With
rc = SHFileOperation(tpFile)
end function

Answer 3

Private Sub Command1_Click() Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As LongDim attribut As SECURITY_ATTRIBUTES
attribut.nLength = Len(attribut)
attribut.lpSecurityDescriptor = &O0
attribut.bInheritHandle = False
   Dim counter As Long
   Dim tnew As String
   Dim onew As String
   Dim i As Long
   Dim lnew As Long
   Dim tx As String
   Dim mi As String
   Dim minstra As Long
   Dim a As String
   a = InputBox("请输入要创建的文件夹名", "创建文件夹名")
   counter = 0
   If Right(a, 1) <> "\" Then
   a = a & "\"
   End If
   lnew = Len(a)
   For i = 1 To lnew
     tx = Left(a, i)
     If Len(tx) > 3 Then
      mi = Right(tx, 1)
      If mi = "\" Then
      Call CreateDirectory(tx, attribut)
      End If
     End If
    Next iend sub