List files in FTP folder to an Access table 1

[mpadova]

I'm using Access 2000. I copied some code that I found on Google to list files on an FTP directory into a table. The code works great when using it to list files in a local folder. When I try the ftp folder, the code runs, but always comes up with 0 files. I'm pretty good at Access but a novice at VBA. I'm sure I'm missing something, like getting the code to open a connection to the FTP directory first.

I've tried using the ftp site, the IP Address and the host name, but none are working. Any help is greatly appreciated. Here's the code and thank you!

Option Compare Database
Option Explicit

'list files to tables
'

http://mydomain.com/uploads

Dim gCount As Long ' added by Crystal

Public Function runListFTPFiles()
'Usage example.
Dim strPath As String _
, strFileSpec As String _
, booIncludeSubfolders As Boolean

'mpadova: Local Folder works:
'strPath = "C:\Parse\TestFiles"
'mpadova: Trying FTP folder, doesn't work:
strPath = "myhost.com\hostfolder\mydomain.com\Uploads"
strFileSpec = "*.*"
booIncludeSubfolders = True

ListFilesToTable2 strPath, strFileSpec, booIncludeSubfolders
End Function


'crystal modified parameter specification for strFileSpec by adding default value
Public Function ListFilesToTable2(strPath As String _
, Optional strFileSpec As String = "*.*" _
, Optional bIncludeSubfolders As Boolean _
)
On Error GoTo Err_Handler
'Purpose: List the files in the path.
'Arguments: strPath = the path to search.
' strFileSpec = "*.*" unless you specify differently.
' bIncludeSubfolders: If True, returns results from subdirectories of strPath as well.
'Method: FilDir() adds items to a collection, calling itself recursively for subfolders.

Dim colDirList As New Collection
Dim varitem As Variant
Dim rst As DAO.Recordset

Dim mStartTime As Date _
, mSeconds As Long _
, mMin As Long _
, mMsg As String

mStartTime = Now()
'--------

Call FillFTPDirToTable(colDirList, strPath, strFileSpec, bIncludeSubfolders)

mSeconds = DateDiff("s", mStartTime, Now())

mMin = mSeconds \ 60
If mMin > 0 Then
mMsg = mMin & " min "
mSeconds = mSeconds - (mMin * 60)
Else
mMsg = ""
End If

mMsg = mMsg & mSeconds & " seconds"

MsgBox "Done adding " & Format(gCount, "#,##0") & " files from " & strPath _
& IIf(Len(Trim(strFileSpec)) > 0, " for file specification --> " & strFileSpec, "") _
& vbCrLf & vbCrLf & mMsg, , "Done"

Exit_Handler:
SysCmd acSysCmdClearStatus
'--------

Exit Function

Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description, , "ERROR"

'remove next line after debugged -- added by Crystal
Stop: Resume 'added by Crystal

Resume Exit_Handler
End Function

Private Function FillFTPDirToTable(colDirList As Collection _
, ByVal strFolder As String _
, strFileSpec As String _
, bIncludeSubfolders As Boolean)

'Build up a list of files, and then add add to this list, any additional folders
On Error GoTo Err_Handler

Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
Dim strSQL As String

'Add the files to the folder.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
gCount = gCount + 1
SysCmd acSysCmdSetStatus, gCount
strSQL = "INSERT INTO WebsiteUploadFiles " _
& " (FName, FPath) " _
& " SELECT """ & strTemp & """" _
& ", """ & strFolder & """;"
CurrentDb.Execute strSQL
colDirList.Add strFolder & strTemp
strTemp = Dir
Loop

If bIncludeSubfolders Then
'Build collection of additional subfolders.
strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
Call FillFTPDirToTable(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
Next vFolderName
End If

Exit_Handler:

Exit Function

Err_Handler:
strSQL = "INSERT INTO WebsiteUploadFiles " _
& " (FName, FPath) " _
& " SELECT "" ~~~ ERROR ~~~""" _
& ", """ & strFolder & """;"
CurrentDb.Execute strSQL

Resume Exit_Handler
End Function

Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
If Right(varIn, 1&) = "\" Then
TrailingSlash = varIn
Else
TrailingSlash = varIn & "\"
End If
End If
End Function

 

[bubba100]

take a look at Thread707-1488600

This is not a directory. strPath= "myhost.com\hostfolder\mydomain.com\Uploads"

This is a directory. strPath = "C:\Parse\TestFiles"

 

[mpadova]

Thanks. I've tried many different things for the strPath like ftp.mydomain.com, ftp://mydomain.com,

http://www.mydomain.com

and about 5 or 6 others. None of them worked. The code works great for local folders though.

Anyway, the article you pointed me to put me back on 'the search' for this answer. I think I found some good code, along with an example database at the following link. It includes listing the contents of an ftp folder, uploading to and downloading from FTP:

http://www.databasejournal.com/features/msaccess/article.php/3513061

Thanks again...