Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA to get list of files on ftp server 3

Status
Not open for further replies.
DevelopV

DevelopV

Technical User
Mar 16, 2012
113
ZA
In Access 2010 I need to get a list of all files in a specific directory on an ftp server and download them to my hard drive.
I never know how many files, or their file names, there are on the ftp server at time of download.

What is the best way to accomplish this?

Many thanks
 
Sort by date Sort by votes
hmm, could it be a bug because there is no remainder and I've been lucky all this time?

before that remainder code put this..

Code: 
MsgBox (iRead <> (iSize Mod BUFFER_SIZE))

if the answer is False, there's the problem!

you need to add this...

Code: 
' Handle remainder using MOD [highlight #FCE94F]if exists[/highlight]
[highlight #EF2929]If iRead <> (iSize Mod BUFFER_SIZE) Then[/highlight]

    ' 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
    
[highlight #EF2929]End If[/highlight]
And there is another lesson in the dangers of Cargo-Cult programming ;-)

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads
 
Upvote 0 Downvote
Sorry, I made a mistake above, it's late and I need to go home, the wife is glaring at me as she's been standing there 20 minutes!

basically check if there is a remainder to download..

Code: 
If iSize Mod BUFFER_SIZE > 0 Then ...


"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads
 
Upvote 0 Downvote
Perhaps you could try my short, uncomplicated version of FTPGet ...
 
Upvote 0 Downvote
It's only complicated if you don't understand it - [lol]

Well if there is one good thing that came out of all this... a bug was fixed in my code ;-)

Guess I'd better do the same for the upload function on Monday [thumbsup2]

At least it's nice to know that when I wrote it, I hadn't got a clue what I was doing, and now I do :)

When I finally finish with my new and vastly improved EmailWrapperII class and release it as an FAQ, I might revisit this and refactor into a proper encapsulated class, it clearly needs a rethink! [sad]

"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads
 
Upvote 0 Downvote
> So it was broke ...

Well, it depends on how you look at it :p

It was only broke for files that were exactly divisible by 100, so in the infamous words of Microsoft, 'No' , it was a 'Feature'! [lol]

What amazes me is I've been using that code since 2006 and this has never broken due to that 'Feature' before, so clearly code that runs for over 6 years without failure can hardly be called 'broken'.

I wonder what the odds of that actually are? Any mathematicians care to comment?




"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads
 
Upvote 0 Downvote
Ok, the files are downloaded but the file sizes are 0
 
Upvote 0 Downvote
Ooops. Ignore previous post about files size being 0
code works with changes suggested.

MANY THANKS FOR YOUR ASSISTANCE
 
Upvote 0 Downvote
strongm

Can you please post your code for the short version to GET a file from a web server?
 
Upvote 0 Downvote
sorry!
I think I need break!
Code: 
Private 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
    If strUser <> "" Then strConnect = strUser & ":" & strPassword & "@"
    Set ftpList = myShell.Namespace("FTP://" & strConnect & strFTPlocation).Items '("ftp://user:password@ftp.site.com")

End Function

This only appears to return one file name only.
How can I populate a list box with all the file names in a folder on the ftp server?

Then I am finished and can leave you both alone!!
 
Upvote 0 Downvote
Code: 
Private Sub cmdDownLoadList_Click()
    
    Dim myFolderItem As FolderItem
    Dim localfolder As Folder
    Dim myShell As New Shell
    
    For Each myFolderItem In ftpList("[URL unfurl="true"]www.mtdomain.com/public_html/tim/webexport/")[/URL] 'Each item could be a folder or a file
        Debug.Print myFolderItem.Name, myFolderItem.IsFolder ' just for fun to illustrate stuff we can do
        If myFolderItem.Name = "olddos.exe" Then
            Set localfolder = myShell.Namespace("F:\temp") ' or wherever your local folder is
            localfolder.CopyHere myFolderItem ' copy the required item
        End If
    Next

End Sub

in the line For Each myFolderItem...... the code moves to Private Function ftpList ......... and hen goes straight to End sub in Private Sub cmdDownLoadList_Click. It bypasses debug.print.... completely!

I can only assume that " is correct because I copy / pasted it from FileZilla.
There are files in this folder!
 
Upvote 0 Downvote
>I can only assume that " is correct because I copy / pasted it from FileZilla

I can't test becasuie I don't have access to that. Indeed, I rather suspect that you don't either, without having previously logged into mtdomain.com (which is often different from simply passing FTP credentials, althopugh the code does allow a username and password). And more worryingly, your previous posts have suggested instead that the domain you are using is actiually mydomain.com, rather than mtdomain.com. Perhaps you can get all this sorted out first.

Note that if you test it with the Microsoft FTP site I used as an example (which does exist and does not require you to be logged in - although you can use FTP anonymous credentials to demonstrate that credentials work), you should see it works fine.


>This only appears to return one file name only.

No, it returns a collection of FolderItems, which we can iterate through. Which is exactly waht we do with "For Each myFolderItem In [etc]"

>It bypasses debug.print.... completely!

Means it is not finding any files (actually, not finding the folder I'd suggest)

And you do rather seem to keep changing your mind about your requirements, which makes it difficult to keep up.
 
Upvote 0 Downvote
I am winning!!!

I have the code working. I was not passing the correct password. How dumb!

However I have found a "bug"

If I add a new file to the ftp server and rerun the cmdDownLoadList_Click event, the new file is not returned.
However if I shut the database down, restart it and run the code the new file is returned.
How do I ensure that I always get the full list of files without having to restart the database?
 
Upvote 0 Downvote
strongm

Can you please post your code to transfer a file TO the Internet? (ftpPut)
 
Upvote 0 Downvote
code works with changes suggested.

MANY THANKS FOR YOUR ASSISTANCE
Click to expand...

No problem, you're welcome.

Glad you got it working, sorry about the 'feature', typical you had a file size divisible exactly by 100 [lol]

Now I have extra work to do tomorrow implementing the 'feature' update :)





"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads
 
Upvote 0 Downvote
Will you kindly post your updated code - with progress meter for multiple files?
Both direction please

Many thanks
 
Upvote 0 Downvote
The code to upload doesn't do multiple files?

You do the multiple files by looping while calling the upload/download code?

Code: 
Dim 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

That concept doesn't change for FTPFile!

Updated FTP routines...
Code: 
Function FTPFile(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 As Integer = 1, Optional ByRef iTot As Integer = 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 upload
Dim Retval As Variant ' Used for progress meter
Dim iWritten As Long ' Used by InternetWriteFile to report bytes uploaded
Dim iLoop As Long ' Loop for uploading chuncks
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_WRITE, 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
    FTPFile = False
    GoTo Exit_Function
End If

' Set Upload Flag to True
FTPFile = True

' Get next file handle number
iFile = FreeFile

' Open local file
Open LocalFileName For Binary Access Read As iFile

' Set file size
iSize = LOF(iFile)

' Initialise progress meter
Retval = SysCmd(acSysCmdInitMeter, "Uploading 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)
        
    'Get file data
    Get iFile, , FileData
      
    ' Write chunk to FTP checking for success
    If InternetWriteFile(hFile, FileData(0), BUFFER_SIZE, iWritten) = 0 Then
        MsgBox "Upload - Failed!"
        ShowError
        FTPFile = False
       GoTo Exit_Function
    Else
        ' Check buffer was written
        If iWritten <> BUFFER_SIZE Then
            MsgBox "Upload - Failed!"
            ShowError
            FTPFile = False
            GoTo Exit_Function
        End If
    End If
    
Next iLoop

' Handle remainder using MOD if exists
[highlight #EF2929]If iSize Mod BUFFER_SIZE > 0 Then[/highlight]

    ' Update progress meter
    Retval = SysCmd(acSysCmdUpdateMeter, iSize / 1000)

    ' Get file data
    Get iFile, , FileData
    
    ' Write remainder to FTP checking for success
    If InternetWriteFile(hFile, FileData(0), iSize Mod BUFFER_SIZE, iWritten) = 0 Then
        MsgBox "Upload - Failed!"
        ShowError
        FTPFile = False
        GoTo Exit_Function
    Else
        ' Check buffer was written
        If iWritten <> iSize Mod BUFFER_SIZE Then
            MsgBox "Upload - Failed!"
            ShowError
            FTPFile = False
            GoTo Exit_Function
        End If
    End If
               
[highlight #EF2929]End If[/highlight]
               
Exit_Function:

' remove progress meter
Retval = SysCmd(acSysCmdRemoveMeter)

'close remote file
Call InternetCloseHandle(hFile)

'close local file
Close iFile

' Close Internet Connection
Call InternetCloseHandle(hOpen)
Call InternetCloseHandle(hConnection)

Exit Function

Err_Function:
MsgBox "Error in FTPFile : " & err.Description
GoTo Exit_Function

End Function


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 As Integer = 1, Optional ByRef iTot As Integer = 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

' Initialise 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 if exists
[highlight #EF2929]If iSize Mod BUFFER_SIZE > 0 Then[/highlight]

    ' 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
    
[highlight #EF2929]End If[/highlight]

    
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 Function



"In complete darkness we are all the same, it is only our knowledge and wisdom that separates us, don't let your eyes deceive you."

"If a shortcut was meant to be easy, it wouldn't be a shortcut, it would be the way!"

Free Dance Music Downloads
 
Upvote 0 Downvote
>your code for the short version to GET
>your code to transfer a file TO the Internet? (ftpPut)

Code: 
[blue]Public Sub FTPGet(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 & "@"
    strSourcePath = "FTP://" & strFTPConnect & strSourcePath
    FTPCopy strSourcePath, strDestPath, strFilename, strUser, strPassword
End Sub

Public 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 Sub

Public Sub FTPCopy(strSourcePath As String, strDestPath As String, strFilename As String, Optional strUser As String, Optional strPassword As String)
    Dim SourceFolder As Folder
    Dim DestFolder As Folder
    Dim myShell As New Shell
    
    Set SourceFolder = myShell.NameSpace(strSourcePath)
    Set DestFolder = myShell.NameSpace(strDestPath)
    DestFolder.CopyHere SourceFolder.Items.Item(strFilename)

End Sub[/blue]

And an example of calling them:

Code: 
[blue]Public Sub Example2()
    FTPGet "ftp.microsoft.com/Products/Windows/Windows95/CDRomExtras/OtherUtilities/", "c:\temp\", "olddos.exe"
    FTPPut "c:\temp\", "ftp.microsoft.com/Products/Windows/Windows95/CDRomExtras/OtherUtilities/", "olddos.exe" ' This will fail, since we don't have permission to do this
End Sub[/blue]
 
Upvote 0 Downvote
strongm

Code: 
Private 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 Function
Code: 
Private Sub cmdDownLoadList_Click()
    
'WORKS. See bug in ftpList
    
Dim myFolderItem As FolderItem
Dim localfolder As Folder
Dim myShell As New Shell
Dim myFiles As String

GetFTPDetails
myFiles = ""
For Each myFolderItem In ftpList(pubServerName & "/" & pubFromInternetFolder & "/", pubUserName, pubPassword)  'Each item could be a folder or a file
    Debug.Print myFolderItem.Name ', myFolderItem.IsFolder Is it a folder?
    myFiles = myFiles & myFolderItem.Name & ";"
Next

Me.lstFiles.RowSource = myFiles
    
End Sub

There appears to be bug in the above code
When I open the database and run the code, the correct file list is returned. If, whilst the database is open, I add or delete a file on the server and rerun the code then the original file list is returned. If I close / open the database and run the code the correct list is returned.

It is almost as though the files names on the first run are kept in cache/memory and the cache/memory is returned, without being updated.

Do I need to add code to clear the cache/memory?

Many thanks

 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

M
  • Locked
  • Question
display a calendar with appointments in body of html email with access vba
Replies
1
Views
2K
SoftwareRT
SoftwareRT
Moss100
  • Locked
  • Question
Filter vba problem
Replies
1
Views
474
Andrzejek
Andrzejek
Omarahmed22
  • Locked
  • Question
VBA Formating
Replies
1
Views
405
Andrzejek
Andrzejek
TheAceMan1
  • Locked
  • Question
Delete from listi n XL open tab with VBA
Replies
2
Views
325
TheAceMan1
TheAceMan1
Moss100
  • Locked
  • Question
Vba adding record to table when field is integer
Replies
8
Views
356
Moss100
Moss100

Part and Inventory Search

Sponsor

Back
Top