vb中复制文件

用API函数 SHFileOperation的方法。

以下是使用SHFileOperation删除复制移动文件的例子，可以复制文件夹

Private 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 '只有在 FOF_SIMPLEPROGRESS 时用

End Type

Private Declare Function SHFileOperation Lib _

"shell32.dll" Alias "SHFileOperationA" (lpFileOp _

As SHFILEOPSTRUCT) As Long

'wFunc 常数

'FO_COPY 把 pFrom 文件拷贝到 pTo。

Const FO_COPY = &H2

'FO_DELETE 删除 pFrom 中的文件（pTo 忽略）。

Const FO_DELETE = &H3

'FO_MOVE 把 pFrom 文件移动到 pTo。

Const FO_MOVE = &H1

'fFlag 常数

'FOF_ALLOWUNDO 允许 Undo 。

Const FOF_ALLOWUNDO = &H40

'FOF_NOCONFIRMATION 不显示系统确认对话框。

Const FOF_NOCONFIRMATION = &H10

'FOF_NOCONFIRMMKDIR 不提示是否新建目录。

Const FOF_NOCONFIRMMKDIR = &H200

'FOF_SILENT 不显示进度对话框

Const FOF_SILENT = &H4

Private Sub Command1_Click()

'例子：

Dim SHFileOp As SHFILEOPSTRUCT

' 拷贝

SHFileOp.wFunc = FO_COPY

SHFileOp.pFrom = "d:\MASM611"

SHFileOp.pTo = "c:\MASM611"

SHFileOp.fFlags = FOF_NOCONFIRMMKDIR

Call SHFileOperation(SHFileOp)

End Sub

或者用命令行

shell "cmd.exe /c xcopy "+chr(34)+"C:\新建文件夹 c:\aa /q /e" +chr(34)

分类: 电脑/网络 >>程序设计 >>其他编程语言

问题描述:

我写的一个程序在用FileCopy复制比较大的文件时会造成程序假死 请问怎么解决？

再请问怎么用ProgressBar控件表示文件复制的进度？ 谢谢了！

解析:

在窗体上添加一个Button、ProgressBar、CommonDialog，把下面的代码复制过去就可以了。

Private Sub Command1_Click()

Dim InputFileName As String

Dim OutputFileName As String

CommonDialog1.ShowOpen

InputFileName = CommonDialog1.FileName

CommonDialog1.ShowSave

OutputFileName = CommonDialog1.FileName

MyFileCopy InputFileName, OutputFileName, ProgressBar1

End Sub

Sub MyFileCopy(sFileName0 As String, sFilename As String, ProgressBarX As MSComctlLib.ProgressBar)

'当 N=0时 ,即 为 Copy

ProgressBarX.Value = ProgressBarX.Min

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)

ProgressBarX.Max = lFileLen \ nKB * KB + IIf(lFileLen Mod nKB * KB >0, 1, 0)

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)

ProgressBarX.Value = ProgressBarX.Value + 1

Loop

If lFileLen >0 Then

ReDim FileBuffer(1 To lFileLen) As Byte

Get #FileNumberS, , FileBuffer

Put #FileNumberT, , FileBuffer

ProgressBarX.Value = ProgressBarX.Value + 1

End If

Close #FileNumberS

Close #FileNumberT

MsgBox "复制完成!"

End Sub

1.VB自己的命令 filecopy text1.text,text2.text 2.VBS的命令 Set fso = CreateObject("Scripting.FileSystemObject") fso.copy text1.text,text2.text 全部删除复制 移动的如下： dim a,b,c On Error Resume Next c=inputbox("请输入 *** 作代码：1.删除；2.复制，3.移动","6921833","D:") a=inputbox("请输入源文件的目录","6921833","D:") if c<>1 then b=inputbox("请输目标文件夹","6921833","D:") else b=0 end if Tree(a,b,c) Set WshSHell = WScript.CreateObject("WScript.Shell") msgbox"OK" Function Tree(sPath,spath2,whatdo) On Error Resume Next Dim WshSHell,oFso Set oFso = CreateObject("Scripting.FileSystemObject") Set oFolder = oFso.GetFolder(sPath) Set oSubFolders = oFolder.Subfolders Set oFiles = oFolder.Files For Each oFile In oFiles '文件 if whatdo=1 then oFile.delete elseif whatdo=2 then oFile.Copy (spath2) elseif whatdo=3 oFile.Movw (spath2) end if Next For Each oSubFolder In oSubFolders TreeIt(oSubFolder.Path)'递归 Next Set objFolder=oFso.Getfolder(a) Set subFolders=objFolder.subFolders For Each subFolder In subFolders On Error Resume Next if whatdo=1 then subfolder.Delete(True) If Err Then err.Clear Else End If Next Set oFolder = Nothing Set oSubFolders = Nothing Set oFso = Nothing End Function

---