急!!!关于文件拷贝??

BBp319 2004-10-28 12:24:25
各位大虾,第一次用VB客户要求的。帮我看看程序。我用了CommonDialog1控件来实现多个文件可以同时拷贝,其中用了COPYFILE函数,但每次返回值为0,拷贝不成功。
'函数声明
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Dim k As Integer
Dim l As Integer
Dim b As Integer
Dim h As Integer
Dim ccc As String
Dim pp As Long

'存储文件名的数组
Dim FileNames$()

CommonDialog1.FileName = ""
CommonDialog1.Filter = "*.txt|*.txt"
'为“打开”和“另存为”对话框返回或设置选项。

'-----------------------------------------------------
CommonDialog1.Flags = cdlOFNAllowMultiselect
CommonDialog1.MaxFileSize = 10240
CommonDialog1.Action = 1
'它指定文件名列表框允许多重选择。运行时,通过按 SHIFT 键以及
'使用 UP ARROW 和 DOWN ARROW 键可选择多个文件。作完此操作后,
'FileName 属性就返回一个包含全部所选文件名的字符串。
'串中各文件名用空格隔开。
CommonDialog1.FileName = CommonDialog1.FileName & Chr(255)
'从返回的字符串中分离出文件名
'经过分离后FileNames(Y)数组存放着选择的文件名信息
'如果只有一个文件 FileNames(0)=“文件名”
'如果有多个文件 FileNames(0)=“路径名” FileNames(1--y)=“文件名”
'这时我们需要对数组进行处理
b = 1
For k = 1 To Len(CommonDialog1.FileName)
'InStr函数,返回 Variant (Long),指定一字符串在另一字符串中最先出现的位置。
'语法 InStr(起点位置, string1, string2)
k = InStr(b, CommonDialog1.FileName, Chr(255))
If k = 0 Then Exit Sub
ReDim Preserve FileNames(l) As String
'Mid函数,返回 Variant (String),其中包含字符串中指定数量的字符。
'语法 Mid(string, start[, length])
FileNames(l) = Mid(CommonDialog1.FileName, b, k - b)
b = k + 1
l = l + 1
Next
ccc = App.Path+"\文件\"
For h = 0 To l - 1
pp = CopyFile(FileNames(h), ccc, True) '*(走到这时,pp的返回值为0,拷贝失败)*
Next
...全文
192 8 打赏 收藏 转发到动态 举报
写回复
用AI写文章
8 条回复
切换为时间正序
请发表友善的回复…
发表回复
junki 2004-10-29
  • 打赏
  • 举报
回复
'文件复制对话框,从进度条上判断当前复制的进度
'当存在同名文件时,会提示是否覆盖,很难出错

声明:
Public Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Public Declare Function SHFileOperation Lib "shell32.dll" Alias _
"SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Public Const FO_COPY = &H2
Public Const FOF_ALLOWUNDO = &H40

代码如下:
Public Sub ShellCopyFile(Source As String, Dest As String)

Dim result As Long
Dim fileop As SHFILEOPSTRUCT

With fileop
.hWnd = 0
.wFunc = FO_COPY
'The files to copy separated by Nulls and terminated by 2 nulls
.pFrom = Source & vbNullChar & vbNullChar
'or to copy all files use this line
'.pFrom = "C:\*.*" & vbNullChar & vbNullChar
'The directory or filename(s) to copy into terminated in 2 nulls
.pTo = Dest & vbNullChar & vbNullChar
.fFlags = FOF_ALLOWUNDO
End With

result = SHFileOperation(fileop)
If result <> 0 Then 'Operation failed
'Msgbox the error that occurred in the API.
MsgBox Err.LastDllError, vbCritical Or vbOKOnly
ElseIf fileop.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed", vbCritical Or vbOKOnly
End If

End Sub
DemonLoveLizzy 2004-10-28
  • 打赏
  • 举报
回复
App.Path+"\文件\",你在APP.PATH下建“文件”这个文件夹了吗?如果没有的话,当然拷贝会失败。
lxcc 2004-10-28
  • 打赏
  • 举报
回复
VB自带的FileCopy就行
FileCopy Src,Des
aohan 2004-10-28
  • 打赏
  • 举报
回复
先试一下手工拷贝,看是否能成功
51365133 2004-10-28
  • 打赏
  • 举报
回复
For h = 0 To l - 1
**********************************
ccc = App.Path+"\文件\" + FileNames(h)
**********************************
pp = CopyFile(FileNames(h), ccc, True) '*(走到这时,pp的返回值为0,拷贝失败)*
Next
51365133 2004-10-28
  • 打赏
  • 举报
回复
For h = 0 To l - 1
**********************************
ccc = App.Path+"\文件\" + FileNames(i)
**********************************
pp = CopyFile(FileNames(h), ccc, True) '*(走到这时,pp的返回值为0,拷贝失败)*
Next
51365133 2004-10-28
  • 打赏
  • 举报
回复
ccc = App.Path+"\文件\"
For h = 0 To l - 1
pp = CopyFile(FileNames(h), ccc, True) '*(走到这时,pp的返回值为0,拷贝失败)*
Next
**********************************
ccc = App.Path+"\文件\" + FileNames
**********************************

wangsitao 2004-10-28
  • 打赏
  • 举报
回复
CopyFile(FileNames(h), ccc, True)
指定True的时候,如果同名文件已经存在的话,会COPY失败
指定FALSE的时候,如果同名文件已经存在的话,会覆盖同名文件

你看一下是不是已经有同名文件存在了

1,486

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧