Chinaunix首页 | 论坛 | 博客
  • 博客访问: 149867
  • 博文数量: 91
  • 博客积分: 3010
  • 博客等级: 中校
  • 技术积分: 970
  • 用 户 组: 普通用户
  • 注册时间: 2009-06-09 11:40
文章分类
文章存档

2011年(1)

2010年(4)

2009年(86)

我的朋友
最近访客

分类:

2009-06-22 12:07:14

Option Explicit
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_MULTIDESTFILES = &H1
Private Const FOF_CONFIRMMOUSE = &H2
Private Const FOF_SILENT = &H4 ' don't create progress/report
Private Const FOF_RENAMEONCOLLISION = &H8
Private Const FOF_NOCONFIRMATION = &H10 ' Don't prompt the user.
Private Const FOF_WANTMAPPINGHANDLE = &H20 ' Fill in SHFILEOPSTRUCT.hNameMappings
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type
Private Const mstrPathExeFrom As String = "E:\TestExe.exe" 'path of source exe file
Private Const mstrPathTxtFrom As String = "E:\TestTxt.txt" 'path of source txt file
Private Const mstrPathExeTo As String = "C:\Test" 'path of target exe file
Private Const mstrPathTxtTo As String = "C:\TestTxt" 'path of target txt file
Private Const mlngNumber As Long = 100 'number of copy
Private Const mstrExtentionExe = ".exe"
Private Const mstrExtentionTxt = ".txt"
'copy function
Function ShellFileOP(sFileArray As String, sDestination As String, iFlg As Integer) As Long
Dim r As Long
Dim sFiles As String
Dim SHFileOp As SHFILEOPSTRUCT
Debug.Print sFileArray
With SHFileOp
Select Case iFlg
Case 1
.wFunc = FO_COPY
Case 2
.wFunc = FO_MOVE
Case Else
End Select
.pFrom = sFileArray
.pTo = sDestination
.fFlags = FOF_SILENT + FOF_NOCONFIRMATION
End With
ShellFileOP = SHFileOperation(SHFileOp)
DoEvents
End Function

Private Sub Form_Load()
Dim nret As Long
Dim i As Long
On Error GoTo ERR_TRAP
'copy to C:\
For i = 1 To mlngNumber
'Exe File
nret = ShellFileOP(mstrPathExeFrom, mstrPathExeTo & i & mstrExtentionExe, 1)
'Txt File
nret = ShellFileOP(mstrPathTxtFrom, mstrPathTxtTo & i & mstrExtentionTxt, 1)
Next i
'project close
End
Exit Sub
ERR_TRAP:
MsgBox Err.Number & ":" & Err.Description, vbCritical, "save error"
Exit Sub
End Sub
阅读(558) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~