Private Sub Command0_Click()
Dim myFolderItem As FolderItem
Dim localfolder As Folder
Dim myShell As New Shell
Dim MyFiles As String
MyFiles = ""
For Each myFolderItem In ftpList("[URL unfurl="true"]www.mydomain.com/public_html/tim/webexport/")[/URL] 'Each item could be a folder or a file
Set localfolder = myShell.Namespace("c:\temp")
localfolder.CopyHere myFolderItem
MyFiles = MyFiles & myFolderItem.Name & ";"
Next
Me.List1.RowSource = MyFiles
End SubPublic Function ftpList(strFTPlocation As String, Optional strUser As String, Optional strPassword As String) As FolderItems
Dim myShell As Shell
Dim strConnect As String
Set myShell = New Shell
strConnect = strUser & ":" & strPassword & "@"
Set ftpList = myShell.Namespace("FTP://" & strConnect & strFTPlocation).Items '("ftp://user:password@ftp.site.com")
[highlight #EF2929] does strFTPlocation above include the folders for the files? e.g [URL unfurl="true"]www.mydomain.com/public_html/tim/webexport/[/URL]
this seems like a duplication in code![/highlight]
End FunctionPrivate Sub Command0_Click()
Dim myFolderItem As FolderItem
Dim localfolder As Folder
Dim myShell As New Shell
Dim MyFiles As String
MyFiles = ""
For Each myFolderItem In ftpList("[URL unfurl="true"]www.mydomain.com/public_html/tim/webexport/")[/URL] 'Each item could be a folder or a file
Set localfolder = myShell.Namespace("c:\temp")
localfolder.CopyHere myFolderItem
MyFiles = MyFiles & myFolderItem.Name & ";"
Next
Me.List1.RowSource = MyFiles
End Sub
Function FTPGet(ByVal HostName As String, _
ByVal Username As String, _
ByVal Password As String, _
ByVal LocalFileName As String, _
ByVal RemoteFileName As String, _
ByVal sDir As String, _
ByVal sMode As String, Optional ByRef iCnt = 1, Optional ByRef iTot = 1) As Boolean
On Error GoTo Err_Function
' Declare variables
Dim hConnection, hOpen, hFile As Long ' Used For Handles
Dim iSize As Long ' Size of file for download
Dim iMaxSize As Long
Dim Retval As Variant ' Used for progress meter
Dim iRead As Long ' Used by InternetReadFile to report bytes downloaded
Dim iLoop As Long ' Loop for downloading chunks
Dim iFile As Integer ' Used for Local file handle
Dim FileData(BUFFER_SIZE - 1) As Byte ' buffer array of BUFFER_SIZE (100) elements 0 to 99
' Open Internet Connecion
hOpen = InternetOpen("FTP", 1, "", vbNullString, 0)
' Connect to FTP
hConnection = InternetConnect(hOpen, HostName, INTERNET_DEFAULT_FTP_PORT, Username, Password, INTERNET_SERVICE_FTP, IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)
' Change Directory
Call FtpSetCurrentDirectory(hConnection, sDir)
' Open Remote File
hFile = FtpOpenFile(hConnection, RemoteFileName, GENERIC_READ, IIf(sMode = "Binary", FTP_TRANSFER_TYPE_BINARY, FTP_TRANSFER_TYPE_ASCII), 0)
' Check for successfull file handle
If hFile = 0 Then
MsgBox "Internet - Failed!"
ShowError
FTPGet = False
GoTo Exit_Function
End If
' Set Download Flag to True
FTPGet = True
' Set file size
iSize = FtpGetFileSize(hFile, iMaxSize)
' Get next file handle number
iFile = FreeFile
' Open local file
Open LocalFileName For Binary Access Write As iFile
' Iinitialise progress meter
Retval = SysCmd(acSysCmdInitMeter, "Downloading File '" & RemoteFileName & "' - " & iCnt & " of " & iTot, iSize / 1000)
' Loop file size
For iLoop = 1 To iSize \ BUFFER_SIZE
' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, (BUFFER_SIZE * iLoop) / 1000)
' Read chunk from FTP checking for success
If InternetReadFile(hFile, FileData(0), BUFFER_SIZE, iRead) = 0 Then
MsgBox "Download - Failed!"
ShowError
FTPGet = False
GoTo Exit_Function
Else
' Check buffer was read
If iRead <> BUFFER_SIZE Then
MsgBox "Download - Failed!"
ShowError
FTPGet = False
GoTo Exit_Function
End If
End If
'put file data
Put iFile, , FileData
Next iLoop
' Handle remainder using MOD
' Update progress meter
Retval = SysCmd(acSysCmdUpdateMeter, iSize / 1000)
' Write remainder to file checking for success
If InternetReadFile(hFile, FileData(0), iSize Mod BUFFER_SIZE, iRead) = 0 Then
MsgBox "Download - Failed!"
ShowError
FTPGet = False
GoTo Exit_Function
Else
' Check buffer was read
If iRead <> iSize Mod BUFFER_SIZE Then
MsgBox "download - Failed!"
ShowError
FTPGet = False
GoTo Exit_Function
End If
End If
' Put file data
Put iFile, , FileData
Exit_Function:
' remove progress meter
Retval = SysCmd(acSysCmdRemoveMeter)
'close local file
Close iFile
'close remote file
Call InternetCloseHandle(hFile)
' Close Internet Connection
Call InternetCloseHandle(hOpen)
Call InternetCloseHandle(hConnection)
Exit Function
Err_Function:
MsgBox "Error in FTPGet : " & err.Description
GoTo Exit_Function
End FunctionsServer = "127.0.0.1"
sUID = "MyUSerID"
sPWD = "MyPassword"
sRemoteFileName = "MyFile.csv"
sPath = "C:\MyPath\"
sMode = "ASCII"
' download file
If Not FTPGet(sServer, sUID, sPWD, sPath & sRemoteFileName, sRemoteFileName, sRemoteFolder, sMode) Then
MsgBox "Error downloading file, please seek support!"
End IfDim i As Integer
Dim bOK As Boolean
For i = 0 To UBound(myFiles)
bOK = FTPGet(sServer, sUID, sPWD, sPath & myFiles(i), myFiles(i), sRemoteFolder, sMode, i+1, Ubound(myFiles)+1)
Next[blue]Public Sub FTPGet(ByVal strFTPLocation As String, ByVal FullLocalPath As String, ByVal strFileName As String, Optional ByVal strUser As String, Optional ByVal strPassword As String)
Dim localfolder As Folder
Dim myShell As New Shell
Dim strConnect As String
Dim ftpFile As FolderItem
If strUser <> "" Then strConnect = strUser & ":" & strPassword & "@"
With myShell.Namespace("FTP://" & strConnect & strFTPLocation)
Set localfolder = myShell.Namespace(FullLocalPath)
If .Items.Count <> 0 Then
If Not .Items.Item(strFileName) Is Nothing Then
localfolder.CopyHere .Items.Item(strFileName), &H4
Else
Err.Raise vbObjectError + 513, "FTPGet", "File " & strFileName & " not found in " & .Title
End If
Else
Err.Raise vbObjectError + 514, "FTPGet", "Bad username/password or bad FTP folder: " & strFTPLocation
End If
End With
End Sub[/blue]Option Explicit
