119.txt

VB文章集（含API、窗口、数据库、多媒体、系统、文件、等等）

用API复制移动文件

在标准模块中添加以下代码：
Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Type SHFILEOPSTRUCT
hwnd As Long '窗口句柄
wFunc As Long '执行的操作
pFrom As String '原地点
pTo As String '目标地点
fFlags As Long '操作执行方式
fAnyOperationsAborted As Long '错误代码返回
hNameMappings As Long
lpszProgressTitle As String
End Type

Public Const FO_MOVE As Long = &H1
Public Const FO_COPY As Long = &H2
Public Const FO_DELETE As Long = &H3
Public Const FO_RENAME As Long = &H4

Public Const FOF_MULTIDESTFILES As Long = &H1
Public Const FOF_CONFIRMMOUSE As Long = &H2
Public Const FOF_SILENT As Long = &H4
Public Const FOF_RENAMEONCOLLISION As Long = &H8
Public Const FOF_NOCONFIRMATION As Long = &H10
Public Const FOF_WANTMAPPINGHANDLE As Long = &H20
Public Const FOF_CREATEPROGRESSDLG As Long = &H0
Public Const FOF_ALLOWUNDO As Long = &H40
Public Const FOF_FILESONLY As Long = &H80
Public Const FOF_SIMPLEPROGRESS As Long = &H100
Public Const FOF_NOCONFIRMMKDIR As Long = &H200
'2 。在form1中添加以下代码以及一个commandbox:
Private Sub Command1_Click()
Dim DelFileOp As SHFILEOPSTRUCT
Dim result As Long
With DelFileOp
.hwnd = Me.hwnd
.wFunc = FO_DELETE '(删除)
'.wfunc=fo_rename(改名) fo_move(移动) fo_copy(拷贝)
' Delete the files you just moved to C:\TestFolder.
' If you do not have these files, you can alter this
' sample to point to existing files.
' .pFrom = "C:\testfolder\file1" & vbNullChar & "c:\testfolder\file2" & vbNullChar & vbNullChar
.pFrom = "d:\testfolder\*" & vbNullChar & vbNullChar
'.pTo = "d:\test" (移动，拷贝时有效)
' Allow undo--in other words, place the files into the Recycle Bin
.fFlags = FOF_ALLOWUNDO
End With
result = SHFileOperation(DelFileOp)
If result <> 0 Then ' Operation failed
If Err.LastDllError <> 0 Then
MsgBox Err.LastDllError ' Msgbox the error that occurred in the API.
End If
Else
If DelFileOp.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed"
End If
End If
End Sub