Hi everybody,
I have to download a directory with its files and subdirectories and their files from a remote server to my HD.
I'm using this code
Code:
Set sh = CreateObject("shell.application")
Set Dest = sh.NameSpace(Destination path)
Dest.copyhere "ftp://Username:Password@ftp.folder"
This works fine except it is quite slow and, mainly, I have to wait for completion before going on but it is asynchrone so I don't know when it is finished.
To check completion I've tried this
Code:
Do Until sh.NameSpace("http://www.folder path").Items.Count = sh.NameSpace(destination path).Items.Count
DoEvents
Loop
but the first term is always zero so infinite loop.
Do you have an idea to check for the .copyhere completion or a faster way to download a full directory ?
I don't know if this is what you're looking for or not, but this is a "FolderCopy" procedure I've used for many years. Below is the source code, and I also zipped it with a form to show how to setup the two list-boxes you'll need.
However, I didn't set up a full demo because I've got no idea what folders you're trying to copy. Just read the comments under the BackupSourceToDestination procedure and it should get you going.
Code:
Option Explicit
'
Private Const MAX_PATH = 260
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
'
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type TwoLongsType
Long1 As Long
Long2 As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
' &h01 bit = read only
' &h02 bit = hidden
' &h04 bit = system
' &h10 bit = folder
' &h20 bit = archive
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
FileSize As TwoLongsType
Reserved As TwoLongsType
'nFileSizeHigh As Long
'nFileSizeLow As Long
'dwReserved0 As Long
'dwReserved1 As Long
cFileName As String * MAX_PATH ' This places a MAX_PATH limit on the file NAME, but not the entire path.
cAlternate As String * 14
End Type
'
'Private Declare Function FindFirstFileA Lib "kernel32" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindFirstFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal lpFindFileData As Long) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
Public gbFolderCopyCancel As Boolean
'
Dim mlAddrFnToExclude As Long
'
Public Sub BackupSourceToDestination(sSource As String, sDestination As String, Optional lRecursionLevel As Long = 0, Optional AddrFnToExclude As Long = 0)
' Be sure that both sSource and sDestination are folders that exist, and they should have their terminating slashes.
'
' This is the standard FolderCopy set of procedures.
' It does require a frm_Load as well as a lstFolders & lstFiles set of listboxes on this frm_Load form.
' Typically, this frm_Load will be a "worker" form that's already loaded but not showing.
' The AddrFnToExclude optional long is the address to a potential filter function. An example is as follows:
'
' Private Function FilenameFilterForMoviePlayerCopying(sFle As String, ByVal arg2 As Long, ByVal arg3 As Long, ByVal arg4 As Long) As Long
' ' Anything non-zero means filter (don't copy).
' FilenameFilterForMoviePlayerCopying = -1
' Select Case True
' Case sFle = "smplayer.ini" ' This is explicitly copied above, so no need to do it here.
' Case Right$(sFle, 4) = "m3u8" ' These are unneeded radio and tv files that keep getting copied.
' Case Else
' FilenameFilterForMoviePlayerCopying = 0
' End Select
' End Function
'
' Create controls for sub-folder recursion.
If lRecursionLevel = 0 Then
gbFolderCopyCancel = False
mlAddrFnToExclude = AddrFnToExclude
Else
Load frm_Load.lstFolders(lRecursionLevel)
Load frm_Load.lstFiles(lRecursionLevel)
End If
' Set source folder.
FillFolderListBox frm_Load.lstFolders(lRecursionLevel), sSource
FillFileListBox frm_Load.lstFiles(lRecursionLevel), sSource
' Validate sub-folder list in destination, creating any new folders.
If Not gbFolderCopyCancel Then ValidateSubFolderList sSource, sDestination, lRecursionLevel
' Go through sub-folders.
If Not gbFolderCopyCancel Then TraverseSourceSubFolders sSource, sDestination, lRecursionLevel
' Update any files that are new or have been changed.
If Not gbFolderCopyCancel Then UpdateFileList sSource, sDestination, lRecursionLevel
' Destroy controls for sub-folder recursion.
If lRecursionLevel <> 0 Then
Unload frm_Load.lstFolders(lRecursionLevel)
Unload frm_Load.lstFiles(lRecursionLevel)
End If
End Sub
Private Sub FillFolderListBox(lst As ListBox, sPath As String)
Dim s As String
lst.Clear
s = SafeDir(sPath & "*.*", vbDirectory + vbReadOnly + vbHidden + vbSystem)
Do While Len(s) <> 0
Select Case True
Case s = "."
Case s = ".."
Case bFolderExists(sPath & s)
lst.AddItem s
End Select
s = Dir$
Loop
End Sub
Private Sub FillFileListBox(lst As ListBox, sPath As String)
Dim sFle As String
Dim lExclude As Long ' Anything non-zero means exclude.
lst.Clear
sFle = SafeDir(sPath & "*.*", vbNormal + vbReadOnly + vbHidden + vbSystem)
Do While Len(sFle) <> 0
lExclude = 0
If mlAddrFnToExclude Then lExclude = CallWindowProc(mlAddrFnToExclude, VarPtr(sFle), 2&, 3&, 4&)
If lExclude = 0 Then lst.AddItem sFle
sFle = Dir$
Loop
End Sub
Private Sub ValidateSubFolderList(sSource As String, sDestination As String, lRecursionLevel As Long)
Dim sMsg As String
Dim iLoop As Long
Dim jLoop As Long
Dim sDFolder As String
Dim sSFolder As String
' Loop through source folders, making sure they exist in destination.
' We don't really need this loop. It would be enough to just check each sub-folder as we get to it. But it works so why change it.
For iLoop = 0 To frm_Load.lstFolders(lRecursionLevel).ListCount - 1
sSFolder = sSource & frm_Load.lstFolders(lRecursionLevel).List(iLoop)
sDFolder = sDestination & frm_Load.lstFolders(lRecursionLevel).List(iLoop)
If Not bFolderExists(sDFolder) Then
If bFileExists(sDFolder) Then Kill sDFolder
MkDir sDFolder
End If
DoEvents ' This will allow a click of the cancel button.
If gbFolderCopyCancel Then Exit For
Next iLoop
End Sub
Private Sub TraverseSourceSubFolders(sSource As String, sDestination As String, lRecursionLevel As Long)
Dim iLoop As Long
Dim sNewSource As String
Dim sNewDestination As String
Dim lNewRecursionLevel As Long
' Go through each source sub-folder and do backup.
For iLoop = 0 To frm_Load.lstFolders(lRecursionLevel).ListCount - 1
sNewSource = AddSlash(sSource & frm_Load.lstFolders(lRecursionLevel).List(iLoop))
sNewDestination = AddSlash(sDestination & frm_Load.lstFolders(lRecursionLevel).List(iLoop))
' If destination folder doesn't exist, we must not have created it (by choice or SafeMakeFolder error).
If bFolderExists(sNewDestination) Then
lNewRecursionLevel = lRecursionLevel + 1
' Recurse to main backup procedure.
BackupSourceToDestination sNewSource, sNewDestination, lNewRecursionLevel
End If
DoEvents
If gbFolderCopyCancel Then Exit For
Next iLoop
End Sub
Private Sub UpdateFileList(sSource As String, sDestination As String, lRecursionLevel As Long)
Dim sMsg As String
Dim iLoop As Long
Dim jLoop As Long
Dim sSFile As String
Dim sDFile As String
Dim sFileName As String
Dim bNeedBackup As Boolean
Dim lReason As Long
Dim wfd As WIN32_FIND_DATA
Dim hSearch As Long
Dim lSSizeLow As Long
Dim lSSizeHigh As Long
Dim dSCreated As Double
Dim dSModified As Double
Dim dSAccessed As Double
Dim lDSizeLow As Long
Dim lDSizeHigh As Long
Dim dDCreated As Double
Dim dDModified As Double
Dim dDAccessed As Double
Dim OneHour As Double
Const INVALID_HANDLE_VALUE = -1
' For daylight savings time.
OneHour = Abs((DateValue("01/01/2001") + TimeValue("3:0:0 am")) - (DateValue("01/01/2001") + TimeValue("4:0:0 am")))
' Go through source file list.
For iLoop = 0 To frm_Load.lstFiles(lRecursionLevel).ListCount - 1
sFileName = frm_Load.lstFiles(lRecursionLevel).List(iLoop)
sSFile = sSource & sFileName
sDFile = sDestination & sFileName
' See if we need to backup the file.
bNeedBackup = False
If Not bFileExists(sDFile) Then
bNeedBackup = True
lReason = 1
Else
' Get source file info.
hSearch = FindFirstFileW(StrPtr(sSFile), VarPtr(wfd))
If hSearch = INVALID_HANDLE_VALUE Then
Err.Raise 99991
Else
FindClose hSearch
lSSizeLow = wfd.FileSize.Long2
lSSizeHigh = wfd.FileSize.Long1
dSCreated = dFileTimeToDouble(wfd.ftCreationTime, True)
dSModified = dFileTimeToDouble(wfd.ftLastWriteTime, True)
dSAccessed = dFileTimeToDouble(wfd.ftLastAccessTime, True)
' Get destination file info.
hSearch = FindFirstFileW(StrPtr(sDFile), VarPtr(wfd))
If hSearch = INVALID_HANDLE_VALUE Then
Err.Raise 99992
Else
' If we got to here, we successfully got the file handles.
FindClose hSearch
lDSizeLow = wfd.FileSize.Long2
lDSizeHigh = wfd.FileSize.Long1
dDCreated = dFileTimeToDouble(wfd.ftCreationTime, True)
dDModified = dFileTimeToDouble(wfd.ftLastWriteTime, True)
dDAccessed = dFileTimeToDouble(wfd.ftLastAccessTime, True)
' Check files for different info.
Select Case True
Case (dSModified > dDModified) And (Abs(dSModified - dDModified) > 0.0001) And (Abs(Abs(dSModified - dDModified) - OneHour) > 0.0001) ' Daylight savings time check.
bNeedBackup = True
lReason = 2
Case dSModified < dDModified And (Abs(dSModified - dDModified) > 0.0001) And (Abs(Abs(dSModified - dDModified) - OneHour) > 0.0001) ' Daylight savings time check.
bNeedBackup = True
lReason = 3
Case lSSizeLow <> lDSizeLow
bNeedBackup = True
lReason = 4
Case lSSizeHigh <> lDSizeHigh
bNeedBackup = True
lReason = 4
End Select
End If
End If
End If
' Do updating, if necessary.
If bNeedBackup Then
FileCopy sSFile, sDFile
End If
Next iLoop
End Sub
Private Function SafeDir(sSpec As String, Optional Attributes As VbFileAttribute = vbNormal) As String
' With vbNormal, it returns only files.
'
' It's good to use this when STARTING a file search.
' That way, if there's a permissions issue, it'll just think that there are no files.
'
On Error Resume Next
SafeDir = Dir$(sSpec, Attributes)
On Error GoTo 0
End Function
Private Function bFileExists(fle As String) As Boolean
On Error GoTo FileExistsError
' If no error then something existed.
bFileExists = (GetAttr(fle) And vbDirectory) = 0
Exit Function
FileExistsError:
bFileExists = False
Exit Function
End Function
Private Function bFolderExists(sDir As String) As Boolean
Dim s As String
s = sDir
If Right$(s, 1) = "\" Then s = Left$(s, Len(s) - 1)
On Error GoTo FileExistsError
' If no error then something existed.
bFolderExists = ((GetAttr(s) And vbDirectory) = vbDirectory)
Exit Function
FileExistsError:
bFolderExists = False
Exit Function
End Function
Private Function AddSlash(sFldr As String) As String
' Only adds it if not there.
' This can be used as EITHER a sub or function, as it modifies the input.
If Right$(sFldr, 1) <> "\" Then sFldr = sFldr & "\"
AddSlash = sFldr
End Function
Private Function dFileTimeToDouble(ftUTC As FILETIME, Optional Localize As Boolean = False) As Double
Dim FT As FILETIME
Dim st As SYSTEMTIME
Dim d As Double
Dim t As Double
' Convert to local filetime, if necessary.
If Localize Then
FileTimeToLocalFileTime ftUTC, FT
Else
FT = ftUTC
End If
' Convert to system time structure.
FileTimeToSystemTime FT, st
' Convert to VB-style date (double).
dFileTimeToDouble = DateSerial(st.wYear, st.wMonth, st.wDay) + TimeSerial(st.wHour, st.wMinute, st.wSecond)
End Function
Just as a warning, once you call this thing, it'll take off and start copying everything that needs to be "refreshed". I'll let you study the code to understand the meaning of "refreshed".
Just as an FYI, to use it, you'd just do something like:
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
I don't have any working samples so I don't know what pitfalls may lay in wait though (e.g. CDECL calling convention). These do appear to require an interactive Windows Station and Desktop though:
Note WinINet does not support server implementations. In addition, it should not be used from a service. For server implementations or services use Microsoft Windows HTTP Services (WinHTTP).
This is the same limitation that the WinINet control that wraps the API has too of course.
Last edited by dilettante; Apr 17th, 2017 at 04:31 AM.
I don't understand what you mean, how FtpFindFirstFile could help nor which limitations you are talking about.
In the same application I use Wininet to upload or download one file at a time; this works fine.
I also use .copyhere method to download a complete directory included its sub-directories and files : it works fine too.
The only problem it that, as it is an asynchoneous process, I don't know when the request is completed.
So my question is
how can I detect that the .copyhere method request is completed
or
which other method should I use to download synchroneously a full folder.
but the first term is always zero so infinite loop.
as the items copied to the destination folder, is the ftp folder the count will only max at 1 (plus any previous files)
you could query the count of files in the destination folder, ftp sub folder
if the ftp folder contains subfolders then the count of the ftp folder items will not be the count of the files to copied, so may match the count even though still copying
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
if the ftp folder contains subfolders then the count of the ftp folder items will not be the count of the files to copied
I have to download a directory with its files and subdirectories and their files.
In other words the ftp folder contains files and subfolders which also contain files, it's a tree.
Either I find a way to count all these items, in the ftp folder and in the local folder as well : whel they are equal the .copyhere asynchroneous process is finished
or I find another way to detect .copyhere process completion
or I find another copy method which is synchroneous.
Unfortunately, according to the documentation, there is no way to know
No notification is given to the calling program to indicate that the copy has completed.
There is no notification given but maybe another way to know, as for instance counting the number of copied files.
Originally Posted by Eduardo-
If you already know how to download one file at a time, why don't
you list the files and folders recursively and download them one by one?
How can I list the files ?
I must also know the directories structure in order to build the same locally.
In fact there is only one level :
main folder
- file
- file
...
- sub-folder
- - file
- - file
- - ...
- sub-folder
- - file
- - file
- - ...
- ...
You could count the files, but how would you know that the last one finished copying already?
You are right,
but at the next step the user must select one of the files (I use commondialog to show the explorer)
and the files are small (5 k for the largest one)
so the time the user makes his choice, the last file will be loaded.
How can I count the number of files on the remote location ?
Last edited by Herve_be; Apr 17th, 2017 at 09:54 AM.
How can I count the number of files on the remote location ?
With API calls it would be with FtpFindFirstFile and InternetFindNextFile. Here there is an example, in the Sub EnumFiles.
With your shell object Set Dest = sh.NameSpace(Destination path), Dest.Items.Count should give you the number of files and folders, to know whether they are files or folders you should navigate the items collection and check that.
Sorry it took me so long to get back. The routine I provided in post #2 will "copy" one folder, in any location, into another folder, also in any location. Also, if you want to use UNC (Universal Naming Convention) rather than drive assignments, that'll work too. Basically, the source and destination "root" folders must exist. After that, it will copy ALL files and ALL folder and ALL files within sub-folders and ALL sub-folders within sub-folders etcetera, into the root destination folder. From your first post, that's what I thought you wanted.
Also, my procedure has checks to see if the current version of any file is already there. If it is, it's skipped. This can vastly improve the speed of things when only a couple of files have changed within 100s or 1000s of files.
Use it if you like, or not.
Take Care,
Elroy
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
some time ago, i did an exercise using copyhere, which i rewrote using the APIs, maybe the code can help you, though as far i remember it does not actually download the files, just recursively iterates through the tree, but would not be hard to download the files too
as all the files are small, and downloading all the files is slow, maybe you only need to download individual the files as the user requires them (after selected), which is what i tried to achieve in the code
you should look at the entire thread as initially it was only for folders, but i added files, on request, in a later post
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Ahhh, yes, mine's not going to FTP unless things are set up such that a UNC path can address the location. Herve_be, if you need an FTP interface, westconn1 may have the answer for you.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Thanks, with your code I can find the files and subdirectories located in the root directory
but not the files located in the sub-directories.
Can you help ?
Well, I've got it !
I remember you that the to be downloaded folder contains files and subfolders containing files, there is no sub-sub folder.
Code:
Dim sh As Object
initdir = "ftp://user:password@ftp.remotedir"
Set sh = CreateObject("shell.application")
Set root = sh.namespace(initdir)
For Each Rootitem In root.Items
If Rootitem.isfolder Then
Set subf = sh.namespace(initdir & "/" & Rootitem.Name)
For Each subitem In subf.Items
Call DownloadFile("http://www.remotedir" & "/" & Rootitem.Name & "/" & subitem.Name, App.Path & "\Templates\" & Rootitem.Name & "\" & subitem.Name)
Next
DoEvents
Else
Call DownloadFile("http://www.remotedir" & "/" & Rootitem.Name, App.Path & "\Templates\" & Rootitem.Name)
End If
DoEvents
Next
Thanks, with your code I can find the files and subdirectories located in the root directory
but not the files located in the sub-directories.
as the point of the code was to list all directories within an ftp directory, you must just pass each sub directory, i initially wrote it as recursive, but with big folders and the slow connection i had at the time, i just passed each subdirectory from the treeview
Can you help ?
as you have not specified which particular code you are using pretty hard to make suggestions, personally i would prefer to use the shell object
if you look at post #9 of the thread that is linked in the first post of the codebank thread, you will find the original recursive procedure that will find all the subdirectories down to however many levels, the reason i changed from that was it was too slow and unnecessary to go through all levels until required, ie if the user selected a subfolder it would then populate all of that folders subfolders, which, i think, should really work for what you are doing, rather than downloading all the files every time, save the user sitting there waiting for the download to complete each time
you may need to combine the recursive procedure with listing the files
if you want further help, post the code as you now have it, make sure to specify what you want to do that is not happening, show any errors that occur, remember, what you want and what i think you want (or should want) may be totally unrelated
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
if the user selected a subfolder it would then populate all of that folders subfolders, which, i think, should really work for what you are doing, rather than downloading all the files every time, save the user sitting there waiting for the download to complete each time
As I told you in post #17 the problem is solved.
I don't want the user to browse the server each time, in normal circumstances he browses his local drive, I only download all files once when there is an new version which I check through another process.
Thanks again, it works fine like that.
i did not see post #17 till now, as i was in reply mode
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete