怎样把一个文件夹下的所有文件包括子目录都copy到指定的目录，然后在删除

Question

敬待

Answer 1

'/工程==>引用==>Microsoft Scripting Runtime
'
'文件夹的复制
'函数:FolderCopy
'参数: SOURFOLDER 源文件夹名,OBJFILDER 目标文件夹名
'返回值:=T 成功,=F 失败.
Function FolderCopy(SourFolder As String, ObjFolder As String) As Boolean
    Dim Fs As New FileSystemObject
    On Error Resume Next
    Fs.CopyFolder SourFolder, ObjFolder, True
    If Err.Number <> 0 Then
       Err.Clear
       FolderCopy = False
    Else
       FolderCopy = True
    End If
End Function

Answer 2

' 比如要将c:\123复制到d:\123，然后再删除Option ExplicitPrivate Sub Command1_Click()
    Dim fso As New FileSystemObject
    fso.CopyFolder "c:\123", "d:\123", True
    fso.DeleteFolder "c:\123", True
End Sub

Answer 3

不就是剪切操作吗？
用API函数直接调用WINDOWS的剪切操作就行了！！Option ExplicitPrivate 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 '  only used if FOF_SIMPLEPROGRESS
End TypePrivate Type BROWSEINFO
    hOwner          As Long
    pidlRoot        As Long
    pszDisplayName  As String
    lpszTitle       As String
    ulFlags         As Long
    lpfn            As Long
    lParam          As Long
    iImage          As Long
End TypePrivate Const BIF_RETURNONLYFSDIRS = &H1
Private Const FO_MOVE As Long = &H1
Private Const FO_COPY As Long = &H2
Private Const FO_DELETE As Long = &H3
Private Const FO_RENAME As Long = &H4Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "Shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As LongPrivate Sub Command1_Click()
    On Error GoTo Errhandle
    Dim i As Long
    Dim r As Long, t As Long
    Dim hWndDesk As Long
    Dim sfile As String
    Dim params As String
    Dim result As Long, fileop As SHFILEOPSTRUCT
    
    Dim bi As BROWSEINFO
    Dim rtn&, pidl&, path$, pos%
    
    bi.hOwner = Me.hwnd
    bi.lpszTitle = "请选择目标文件夹..."
    bi.ulFlags = BIF_RETURNONLYFSDIRS
    pidl& = SHBrowseForFolder(bi)
    path = Space(255)
    t = SHGetPathFromIDList(ByVal pidl&, ByVal path)    If t = 0 Then Exit Sub
    
    With fileop
        params = vbNullString
        hWndDesk = GetDesktopWindow()
        
        .hwnd = Me.hwnd
        .wFunc = FO_MOVE
        .pFrom = "D:\temp" & vbNullChar & vbNullChar
        path = Space(512)
        t = SHGetPathFromIDList(ByVal pidl&, ByVal path)        Dim SpecIn, SpecOut
        
        pos% = InStr(path$, Chr$(0))
        SpecIn = Left(path$, pos - 1)
        If Right$(SpecIn, 1) = "\" Then
            SpecOut = SpecIn
        Else
            SpecOut = SpecIn + "\"
        End If
        
        .pTo = SpecOut & vbNullChar & vbNullChar
        result = SHFileOperation(fileop)
        
        If result <> 0 Then
            MsgBox "对不起，操作失败！", vbExclamation
        Else
            If fileop.fAnyOperationsAborted <> 0 Then
                MsgBox "对不起，操作失败！", vbExclamation
            End If
        End If
        DoEvents
    End With
    
    DoEvents
    Exit Sub
    
Errhandle:
    MsgBox Err.Description
End Sub