-
I am using the SHFileOperation Function to copy files from one location to another
this function contains a flag ( FOF_SIMPLEPROGRESS)
which displays a progress dialog while the files are being copied. However I cannot get the progress dialog to work. Can anybody see where I am going wrong any help is greatly appreciated
code in module
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 String
End Type
Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long)
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
(lpFileOp As Byte) As Long
Public Const FO_DELETE = &H3
Public Const FOF_ALLOWUNDO = &H40
Public Const FOF_FILESONLY = &H80
Public Const FO_COPY = &H2
Public Const FO_RENAME = &H4
Public Const FOF_SIMPLEPROGRESS = &H100
code in command button
Private Sub Command3_Click()
Dim fos As SHFILEOPSTRUCT
Dim sa(1 To 32) As Byte
Dim retval As Long
With fos
.hwnd = Form1.hwnd
.wFunc = FO_COPY
.pFrom = Combo1 & vbNullChar & vbNullChar
.pTo = Combo2 & vbNullChar & vbNullChar
.fFlags = FOF_SIMPLEPROGRESS Or FOF_ALLOWUNDO Or FOF_FILESONLY
.fAnyOperationsAborted = 0
.hNameMappings = 0
.lpszProgressTitle = "Copying Files vbNullChar"
End With
CopyMemory sa(1), fos, LenB(fos)
CopyMemory sa(19), sa(21), 12
retval = SHFileOperation(sa(1))
CopyMemory sa(21), sa(19), 12
CopyMemory fos, sa(1), Len(fos)
End Sub
-
Try this, the progress bar will automatically display when copying large number of files:
In normal module:
Code:
Option Explicit
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 Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Const FOF_NOCONFIRMATION = &H10 ' Don't prompt the user.
Const FOF_NOCONFIRMMKDIR = &H200 ' don't confirm making any needed dirs
Const FO_COPY = &H2
Public Function NucCopy(source As String, target As String) As Boolean
'Copy file(s)/directories from source To destination
'In path of source either file(s) Or folder And path of target As folder
'Out: Boolean indicating success
Dim SHFileOp As SHFILEOPSTRUCT ' structure To pass To the Function
With SHFileOp
.wFunc = FO_COPY
.pFrom = source
.pTo = target
.fFlags = FOF_NOCONFIRMATION Or FOF_NOCONFIRMMKDIR
End With
SHFileOperation SHFileOp
NucCopy = True
End Function
Usage:
Code:
Private Sub Command1_Click()
Call NucCopy("c:\tmp", "c:\test\test") ' copy whole folder including subdirectories
Call NucCopy("c:\tmp\*.txt", "c:\test") ' copy all text files In a folder
Call NucCopy("c:\tmp\american.txt", "c:\test") ' copy a file
End Sub
