上面的方法都是异步的,我建议自己编一个,参阅:
Sub MyFileCopy(sFileName0 As String, sFilename As String, Optional N As Long = 0)
'当 N=0时 ,即 为 Copy
Const KB = 1024
Dim nKB As Long
nKB = 64
Dim FileBuffer() As Byte
Dim FileNumberS As Long
Dim FileNumberT As Long
Dim lFileLen As Long
lFileLen = FileLen(sFileName0) - N
FileNumberS = FreeFile
Open sFileName0 For Binary Access Read As #FileNumberS
FileNumberT = FreeFile
Open sFilename For Binary Access Write As #FileNumberT
ReDim FileBuffer(1 To (nKB * KB)) As Byte '设 置 缓 冲 区 大 小 为 64K
'若 用 Do Until LOF(FileNumber)
' ...
' Loop 语 句 ,
'不 方 便 ,复 杂 !
Do While lFileLen >= (nKB * KB)
Get #FileNumberS, , FileBuffer
Put #FileNumberT, , FileBuffer
lFileLen = lFileLen - (nKB * KB)
Loop
If lFileLen > 0 Then
ReDim FileBuffer(1 To lFileLen) As Byte
Get #FileNumberS, , FileBuffer
Put #FileNumberT, , FileBuffer
End If
Close #FileNumberS
Close #FileNumberT
MsgBox "End!"
End Sub
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal_
lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) _
As Long
这个问题注意三个方面:
1.命令就是纯dos的命令
2.不出现DOS窗口
3.不能异步执行,这句还没执行完,就执行下面语句了
在http://wuf.yeah.net/有这三个问题的详细解决方案
有进一步的要求, 可向我索要另外的源码
例如:
If Len(mlm) <= 3 Or Right(mlm, 1) = "\" Then
MsgBox "目的目录不允许为根目录且不用加 \"
Text2.SetFocus
Exit Sub
End If
If Len(Trim(Dir(mlm, 16))) > 0 Then
Dim Response
SendKeys "{TAB}"
Response = MsgBox("目录 [" & mlm & "] 已存在,你确信删除吗?", vbYesNo, "【提醒】")
If Response = 6 Then
Shell "Command.com /C deltree.exe /y " & mlm, vbMinimizedNoFocus
Else
MsgBox "由于该目录已存在,程序停止传送文件!"
Exit Sub
End If
End If