vba 使用进度条复制文件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/14227172/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Copy files with progress bar
提问by user1959879
So I am trying to do something in visual basic I start learning but still that is not enough. Mostly I am using codes from internet. Now I want to copy few files from first folder to second folder and overwrite existing files and I want to see progress on progress bar (all files together are about 2GB)
所以我试图在视觉基础上做一些我开始学习的事情，但这还不够。大多数情况下，我使用来自互联网的代码。现在我想将几个文件从第一个文件夹复制到第二个文件夹并覆盖现有文件，我想在进度条上看到进度（所有文件加起来大约 2GB）
SOLVED: I found source code for some program and used some parts to make this work
已解决：我找到了一些程序的源代码并使用了一些部分来完成这项工作
回答by Siddharth Rout
Here is my favorite way of doing it... Using the SHFileOperationAPI
这是我最喜欢的做法……使用SHFileOperationAPI
This API will automatically show the progress as shown in the screenshot below.
此 API 将自动显示进度，如下面的屏幕截图所示。
Here is an example. Paste this code in a module
这是一个例子。将此代码粘贴到模块中
Public Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Public Const FO_COPY = &H2
Public Const FOF_SIMPLEPROGRESS = &H100
Public 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 Long
End Type
Public Sub VBCopyFolder(ByRef strSource As String, ByRef strTarget As String)
Dim op As SHFILEOPSTRUCT
With op
.wFunc = FO_COPY
.pTo = strTarget
.pFrom = strSource
.fFlags = FOF_SIMPLEPROGRESS
End With
'~~> Perform operation
SHFileOperation op
End Sub
and then copy files or folders like this
然后像这样复制文件或文件夹
Private Sub Sample()
'~~> Copy Files
Call VBCopyFolder("C:\Sample.Avi", "C:\NewSample.Avi")
'~~> Copy Folders
Call VBCopyFolder("C:\Temp1", "C:\Temp2")
End Sub
Screenshot
截屏
