Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)' sleep 1 second
Sleep 1000Public Sub GetFileList()
Dim myFolderItem As FolderItem
Dim myFiles As String
myFiles = ""
For Each myFolderItem In ftpList("[URL unfurl="true"]www.mydomain.com/public_html/tim/webexport/",[/URL] pubInternetFTPUserName, pubInternetFTPPassword)
myFiles = myFiles & myFolderItem.Name & ";"
Next
Me.lstAvialableFilesForDownload.RowSource = myFiles
End SubPrivate Sub cmdUploadFiles_Click()
Dim FileToCopy As String
Dim FileToCopyFrom As String
Dim FileToCopyTo As String
Dim lstCount As Integer
For varItem = 0 To Me.lstAvialableFilesForUpload.ListCount - 1
FileToCopy = Me.lstAvialableFilesForUpload.Column(0, varItem)
FileToCopyFrom = pubWebOrderUploadDataFromLocalFolder & "\"
FTPPut FileToCopyFrom, pubInternetDomainName & "/" & pubWebOrderUploadDataToInternetFolder & "/", FileToCopy, pubInternetFTPUserName, pubInternetFTPPassword
Kill FileToCopyFrom & "\" & FileToCopy
Next
End SubPublic Sub FTPPut(strSourcePath As String, strDestPath As String, strFilename As String, Optional strUser As String, Optional strPassword As String)
Dim strFTPConnect As String
If strUser <> "" Then strFTPConnect = strUser & ":" & strPassword & "@"
strDestPath = "FTP://" & strFTPConnect & strDestPath
FTPCopy strSourcePath, strDestPath, strFilename, strUser, strPassword
End SubPublic Sub FTPCopy(strSourcePath As String, strDestPath As String, strFilename As String, Optional strUser As String, Optional strPassword As String)
Dim SourceFolder As Shell32.Folder
Dim DestFolder As Shell32.Folder
Dim myShell As New Shell32.Shell
Set SourceFolder = myShell.Namespace(strSourcePath)
Set DestFolder = myShell.Namespace(strDestPath)
DestFolder.CopyHere SourceFolder.Items.item(strFilename)
End SubPublic Function ftpList(strFTPLocation As String, Optional strUser As String, Optional strPassword As String) As FolderItems
' Returns a FolderItems collection from the FTP server
'Works. Bug in that list is not updated after 1st rub. Database needs to be restarted
Dim myShell As Shell
Dim strConnect As String
Set myShell = New Shell
If strUser <> "" Then strConnect = strUser & ":" & strPassword & "@"
Set ftpList = myShell.Namespace("FTP://" & strConnect & strFTPLocation).Items '("ftp://user:password@ftp.site.com")
End FunctionYes and I posted above (18 Feb 13 4:38) and I highlighted where the changes were made and I also included the counter (x of x) optional parameters for both routines.
