Code for controling FTP from Access VBA

[Lauren Wilson]

Hi folks,

Can someone point me to some resources on how to control FTP sessions
from and Access application with VBA?

Many thanks for all help.

--LW.

[Douglas J. Steele]

Two different approaches are shown at "The Access Web"

http://www.mvps.org/access/modules/mdl0015.htm shows how to automate passing
a script to the ftp command, while
http://www.mvps.org/access/modules/mdl0037.htm uses the Internet Data
Transfer object.

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no e-mails, please!)

"Lauren Wilson" <no****@none.com> wrote in message
news:ec********************************@4ax.com...

Hi folks,

Can someone point me to some resources on how to control FTP sessions
from and Access application with VBA?

Many thanks for all help.

--LW.

[Lauren Wilson]

Thanks Douglas.

Ting! Your kindness will be rewarded!

I searched the Access Web but apparently could not see this result
amid the blizzard of search responses that did not match my criteria.
What is it with some search engines anyway?
On Sat, 24 Sep 2005 07:13:06 -0400, "Douglas J. Steele"
<NOSPAM_djsteele@NOSPAM_canada.com> wrote:

Two different approaches are shown at "The Access Web"

http://www.mvps.org/access/modules/mdl0015.htm shows how to automate passing
a script to the ftp command, while
http://www.mvps.org/access/modules/mdl0037.htm uses the Internet Data
Transfer object.

[Trevor Best]

Lauren Wilson wrote:

I searched the Access Web but apparently could not see this result
amid the blizzard of search responses that did not match my criteria.
What is it with some search engines anyway?

?

They're the first two results to come up if you search for "FTP".

[David W. Fenton]

"Douglas J. Steele" <NOSPAM_djsteele@NOSPAM_canada.com> wrote in
news:7K********************@rogers.com:

Two different approaches are shown at "The Access Web"

http://www.mvps.org/access/modules/mdl0015.htm shows how to
automate passing a script to the ftp command, while
http://www.mvps.org/access/modules/mdl0037.htm uses the Internet
Data Transfer object.

You can also write a custom FTP script in code and save it. I have
had several apps where I do exactly that, so that values specific to
that session can be included.

If you use that method, you can also execute your FTP script using
ShellWait (also available on the Access Web) to have your code pause
until the FTP session finishes.

--
David W. Fenton http://www.bway.net/~dfenton
dfenton at bway dot net http://www.bway.net/~dfassoc

[Danny J. Lesandrini]

I worked on Dev's code and wrote an article about it. There's a download
available that will help with some of the issues.

http://www.databasejournal.com/featu...le.php/3513061
--

Danny J. Lesandrini
dl*********@hotmail.com
http://amazecreations.com/datafast/

"Lauren Wilson" <no****@none.com> wrote in message news:ec********************************@4ax.com...

Hi folks,

Can someone point me to some resources on how to control FTP sessions
from and Access application with VBA?

Many thanks for all help.

--LW.

[Lauren Wilson]

On Mon, 26 Sep 2005 09:17:40 -0600, "Danny J. Lesandrini"
<dl*********@hotmail.com> wrote:

I worked on Dev's code and wrote an article about it. There's a download
available that will help with some of the issues.

http://www.databasejournal.com/featu...le.php/3513061

Thanks Danny. Excellent article. Please ignore the email I sent from
your site too quickly. I did find the download link.

--LW

[jimfortune]

I found:

http://groups.google.com/group/comp....c794782?hl=en&

It looks interesting. Has Lyle updated it since then?

James A. Fortune

Microsoft has taken unprecedented steps to fully describe through a
completely W3C-compliant XML structure the way the current editions of
Microsoft Office docs are represented when saved as XML. The first
time Microsoft worked with XML was in Office 2000 (development started
in 1997), and the upcoming Office 12 file format will see the first
time XML is used as a default file format in Office products (as
opposed to the "binary" formats, i.e., .doc for Word, .xls for Excel,
and .ppt for PowerPoint).

http://www.mass.gov/portal/site/mass...soft&csid=Aitd

[lylefair]

ji********@compumarc.com wrote:

I found:

http://groups.google.com/group/comp....c794782?hl=en&

It looks interesting. Has Lyle updated it since then?

I don't use FTP tody as ADO gives me a simpler, cleaner method:

Public Sub UploadFile( _
ByVal FromPath As String, _
ByVal ToFile As String, _
ByVal Server As String)
Dim r As ADODB.Record
Dim s As ADODB.Stream
Set r = New ADODB.Record
Set s = New ADODB.Stream
r.Open Server & "/" & ToFile, , adModeWrite, adCreateOverwrite
With s
.Open r, , adOpenStreamFromRecord
.Type = adTypeBinary
.LoadFromFile FromPath
.Close
End With
r.Close
End Sub

Sub test()
UploadFile "c:\IMG_0414.JPG", "neys.jpg", "http://ffdba.com"
Application.FollowHyperlink "http://ffdba.com/neys.jpg"
End Sub

[jimfortune]

lylefair wrote:

ji********@compumarc.com wrote:

I found:

http://groups.google.com/group/comp....c794782?hl=en&

It looks interesting. Has Lyle updated it since then?

I don't use FTP tody as ADO gives me a simpler, cleaner method:

Public Sub UploadFile( _
ByVal FromPath As String, _
ByVal ToFile As String, _
ByVal Server As String)
Dim r As ADODB.Record
Dim s As ADODB.Stream
Set r = New ADODB.Record
Set s = New ADODB.Stream
r.Open Server & "/" & ToFile, , adModeWrite, adCreateOverwrite
With s
.Open r, , adOpenStreamFromRecord
.Type = adTypeBinary
.LoadFromFile FromPath
.Close
End With
r.Close
End Sub

Sub test()
UploadFile "c:\IMG_0414.JPG", "neys.jpg", "http://ffdba.com"
Application.FollowHyperlink "http://ffdba.com/neys.jpg"
End Sub

That's one lovely subroutine. I'll use it. Thanks.

James A. Fortune

If Adobe had written Access, dll functions would probably now be
capable of being embedded into the executable so that the .exe will run
the same way on differing machines regardless of dll differences :-).

[Lauren Wilson]

On 29 Sep 2005 22:56:57 -0700, "lylefair" <ly******@yahoo.ca> wrote:

ji********@compumarc.com wrote:

I found:

http://groups.google.com/group/comp....c794782?hl=en&

It looks interesting. Has Lyle updated it since then?
I don't use FTP tody as ADO gives me a simpler, cleaner method:

Lyle, Thanks for your contribution. However, please indulge my
incredible ignorance. How does the following code accomplish the
purpose of connecting to a server, reading directories, up/downloading
files, etc? Forgive me, but I thought that's what this thread was
about.

On closer examination, I see a server reference. I am really limited
with ADO so far. I assume the server reference is a string like
"ftp://domainname.com" or something like that -- correct. If so, how
does this sub pas the login info?


Public Sub UploadFile( _
ByVal FromPath As String, _
ByVal ToFile As String, _
ByVal Server As String)
Dim r As ADODB.Record
Dim s As ADODB.Stream
Set r = New ADODB.Record
Set s = New ADODB.Stream
r.Open Server & "/" & ToFile, , adModeWrite, adCreateOverwrite
With s
.Open r, , adOpenStreamFromRecord
.Type = adTypeBinary
.LoadFromFile FromPath
.Close
End With
r.Close
End Sub

Sub test()
UploadFile "c:\IMG_0414.JPG", "neys.jpg", "http://ffdba.com"
Application.FollowHyperlink "http://ffdba.com/neys.jpg"
End Sub

[Lauren Wilson]

On 29 Sep 2005 20:49:11 -0700, ji********@compumarc.com wrote:

I found:

http://groups.google.com/group/comp....c794782?hl=en&
The code from the above link looks good except for one thing. The
following code at the bottom of the listing is as follows:

************
* calling as
************
Dim cFTP As clsFTP
Set cFTP = New clsFTP
If Not gCancelFTP Then
With cFTP
.ServerName = DBEngine(0)(0).Properties("ServerName")
If Not .IsConnected Then
DoCmd.OpenForm "frmLogon", acNormal, , , acFormEdit,
acDialog
End If
.UserName = gUserName
.PassWord = gPassWord
.ConnectToServer
If .IsConnected Then
strFTPDirectory = DBEngine(0)(0).Properties("FamiliesFTP")
AC97Replace strFTPDirectory, "\", 1, "/"
If Left(strFTPDirectory, 1) <> "/" Then strFTPDirectory =
"/"
& strFTPDirectory Do While Right(strFTPDirectory, 1) = "/"
strFTPDirectory = Left(strFTPDirectory,
Len(strFTPDirectory) - 1) If Len(strFTPDirectory) = 0
Then
Exit Do
Loop
.DirectoryName = strFTPDirectory
If .SetCurrentDirectory Then
booCanFTP = True
Else
.ShowLastResponseInfo
End If
Else
.ShowLastResponseInfo
End If
End With
End If
If booCanFTP Then
With cFTP
FileName strHTMPath
.WriteFileName = strHTMPath
.WriteBuffer = Stream
If .OpenForWrite Then
lngBytesWritten = .WriteToFile
If lngBytesWritten <> 0 Then
lngFilesUploaded = lngFilesUploaded + 1
Else
.ShowLastResponseInfo
End If
Else
.ShowLastResponseInfo
End If
End With
End If
Set cFTP = Nothing
well ... it's a bit old ... but it seemed to work on several servers
unfortunately word wrap will be a problem here ... but since
attachments are banned ...
--
Lyle

It won't compile because it's missing the Sub header. I don't know
what to call it. Anyone have a clue?

Thanks.

It looks interesting. Has Lyle updated it since then?

James A. Fortune

Microsoft has taken unprecedented steps to fully describe through a
completely W3C-compliant XML structure the way the current editions of
Microsoft Office docs are represented when saved as XML. The first
time Microsoft worked with XML was in Office 2000 (development started
in 1997), and the upcoming Office 12 file format will see the first
time XML is used as a default file format in Office products (as
opposed to the "binary" formats, i.e., .doc for Word, .xls for Excel,
and .ppt for PowerPoint).

http://www.mass.gov/portal/site/mass...soft&csid=Aitd

[Lyle Fairfield]

Lauren

I am reluctant to post this because:
a) I don't use it any more; I use ADO for Internet Publishing to sites
that are FrontPage or IIS empowered;
b) it's not easy to implement;
c) it's big, ugly and old;
d) implementing it can be difficult and things must be "just so"

Against my better judgement:

(of course, all the code may be corrupted with news client inserted line
feeds)

This is the Class. (The Class will do many things beyond uploading a
file.) It must go in its own separate class module:
'**** begin class named clsFTP ****

Option Explicit

Private Const INTERNET_ERROR_BASE As Long = 12000
Private Const ERROR_FTP_TRANSFER_IN_PROGRESS As Long =
INTERNET_ERROR_BASE + 110
Private Const ERROR_FTP_DROPPED As Long = INTERNET_ERROR_BASE + 111
Private Const ERROR_FTP_NO_PASSIVE_MODE As Long = INTERNET_ERROR_BASE + 112
Private Const ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED As Long =
INTERNET_ERROR_BASE + 44
Private Const ERROR_INTERNET_INCORRECT_PASSWORD = INTERNET_ERROR_BASE + 14
Private Const ERROR_INVALID_HANDLE As Long = 6
Private Const ERROR_NO_ERROR As Long = 0
Private Const ERROR_NO_MORE_FILES As Long = 18
Private Const ERROR_SUCCESS As Long = ERROR_NO_ERROR
Private Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Private Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
Private Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const FILE_ATTRIBUTE_OFFLINE As Long = &H1000
Private Const FILE_ATTRIBUTE_READONLY As Long = &H1
Private Const FILE_ATTRIBUTE_SYSTEM As Long = &H4
Private Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100
Private Const FLAGS_ERROR_UI_FILTER_FOR_ERRORS As Long = &H1
Private Const FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS As Long = &H2
Private Const FLAGS_ERROR_UI_FLAGS_GENERATE_DATA As Long = &H4
Private Const FLAGS_ERROR_UI_FLAGS_NO_UI As Long = &H8
Private Const FLAGS_ERROR_UI_SERIALIZE_DIALOGS As Long = &H10
Private Const FTP_TRANSFER_TYPE_ASCII As Long = &H1
Private Const FTP_TRANSFER_TYPE_BINARY As Long = &H2
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const INTERNET_DEFAULT_FTP_PORT As Long = 21
Private Const INTERNET_DEFAULT_GOPHER_PORT As Long = 70
Private Const INTERNET_DEFAULT_HTTP_PORT As Long = 80
Private Const INTERNET_DEFAULT_HTTPS_PORT As Long = 443
Private Const INTERNET_DEFAULT_SOCKS_PORT As Long = 1080
Private Const INTERNET_FLAG_RESYNCHRONIZE As Long = &H800
Private Const INTERNET_FLAG_HYPERLINK As Long = &H400
Private Const INTERNET_FLAG_NO_UI As Long = &H200
Private Const INTERNET_FLAG_PRAGMA_NOCACHE As Long = &H100
Private Const INTERNET_FLAG_CACHE_ASYNC As Long = &H80
Private Const INTERNET_FLAG_FORMS_SUBMIT As Long = &H40
Private Const INTERNET_FLAG_NEED_FILE As Long = &H10
Private Const INTERNET_FLAG_MUST_CACHE_REQUEST As Long =
INTERNET_FLAG_NEED_FILE
Private Const INTERNET_FLAG_KEEP_CONNECTION As Long = &H400000
Private Const INTERNET_FLAG_MULTIPART As Long = &H200000
Private Const INTERNET_FLAG_PASSIVE As Long = &H8000000
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Private Const INTERNET_INVALID_PORT_NUMBER As Long = 0
Private Const INTERNET_OPEN_TYPE_DIRECT As Long = 1
Private Const INTERNET_OPEN_TYPE_PRECONFIG As Long = 0
Private Const INTERNET_OPEN_TYPE_PROXY As Long = 3
Private Const INTERNET_OPTION_CONNECT_TIMEOUT As Long = 2
Private Const INTERNET_OPTION_PASSWORD As Long = 29
Private Const INTERNET_OPTION_PROXY_PASSWORD As Long = 44
Private Const INTERNET_OPTION_PROXY_USERNAME As Long = 43
Private Const INTERNET_OPTION_RECEIVE_TIMEOUT As Long = 6
Private Const INTERNET_OPTION_SEND_TIMEOUT As Long = 5
Private Const INTERNET_OPTION_USERNAME As Long = 28
Private Const INTERNET_OPTION_VERSION As Long = 40
Private Const INTERNET_SERVICE_FTP As Long = 1
Private Const INTERNET_SERVICE_GOPHER As Long = 2
Private Const INTERNET_SERVICE_HTTP As Long = 3
Private Const MAX_PATH As Long = 260

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias
"FtpCreateDirectoryA" _
(ByVal hFtpSession As Long, ByVal strFilename As String) As Boolean

Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias
"FtpDeleteFileA" _
(ByVal hFtpSession As Long, ByVal strFilename As String) As Boolean

Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias
"FtpFindFirstFileA" _
(ByVal hFtpSession As Long, ByVal strSearchFile As String, _
lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, _
ByVal dwContent As Long) As Long

Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias
"FtpGetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal strDirectoryName As String,
lngLengthBuffer As Long) As Boolean

Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByVal strRemoteFile As String, _
ByVal strNewFile As String, ByVal fFailIfExists As Boolean, _
ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean

Private Declare Function FtpGetFileSize Lib "wininet.dll" _
(ByVal hOpenFileHandle As Long, lngFileSize As Long) As Long

Private Declare Function FtpOpenFile Lib "wininet.dll" Alias
"FtpOpenFileA" _
(ByVal hFtpSession As Long, ByVal strFilename As String, _
ByVal lAccess As Long, ByVal lFlags As Long, _
ByVal lContext As Long) As Long

Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, ByVal strLocalFile As String, _
ByVal strRemoteFile As String, _
ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean

Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias
"FtpRemoveDirectoryA" _
(ByVal hFtpSession As Long, ByVal strFilename As String) As Boolean

Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias
"FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal strDirectoryName As String) As
Boolean

Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer

Private Declare Function InternetConnect Lib "wininet.dll" Alias
"InternetConnectA" _
(ByVal hInternetSession As Long, ByVal strServerName As String, _
ByVal intServerPort As Integer, ByVal strUserName As String, _
ByVal strPassWord As String, ByVal lngService As Long, _
ByVal lngFlags As Long, ByVal lngContext As Long) As Long

Private Declare Function InternetErrorDlg Lib "wininet.dll" _
(hwnd As Long, ByVal hInternet As Long, _
ByVal lngError As Long, ByVal lngFlags As Long, Optional lngStruc
As Long) As Long

Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias
"InternetFindNextFileA" _
(ByVal hFoundFile As Long, lpFindFileData As WIN32_FIND_DATA) As
Boolean

Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _
Alias "InternetGetLastResponseInfoA" _
(lngError As Long, _
ByVal strBuffer As String, _
lngBufferLength As Long) As Boolean

Private Declare Function InternetOpen Lib "wininet.dll" Alias
"InternetOpenA" _
(ByVal strAgent As String, ByVal lngAccessType As Long, _
ByVal strProxyName As String, ByVal strProxyBypass As String, _
ByVal lngFlags As Long) As Long

Private Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hFtpSession As Long, ByVal strBuffer As String, _
ByVal lngLengthBuffer As Long, lngBytesRead As Long) As Boolean

Private Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFtpSession As Long, ByVal strBuffer As String, _
ByVal lngLengthBuffer As Long, lngBytesWritten As Long) As Boolean

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetLastError Lib "kernel32" () As Long

Dim mHInternet As Long
Dim mHConnect As Long
Dim mHFoundFile As Long
Dim mHOpenFile As Long

Dim mBooFailIfExists As Boolean

Dim mStrDirectoryName As String
' as Genealogy/DynamicTree/Families
Dim mStrFindFileName As String
Dim mStrDeleteFileName As String
Dim mStrDownLoadFileName As String
Dim mStrNewDownLoadFileName As String
Dim mStrNewUpLoadFileName As String
Dim mStrPassWord As String
Dim mStrUpLoadFileName As String
Dim mStrReadBuffer As String
Dim mStrReadFileName As String
Dim mStrServerName As String
' as ftp.cyriv.com
Dim mStrUserName As String
Dim mStrWriteBuffer As String
Dim mStrWriteFileName As String
Dim mWFD As WIN32_FIND_DATA

Private Sub Class_Initialize()
mHInternet = InternetOpen("Microsoft Access",
INTERNET_OPEN_TYPE_DIRECT, _
vbNullString, vbNullString, 0)
If mHInternet = 0 Then
MsgBox "Could not open Internet Connection", vbCritical, "FTP"
Class_Terminate
End If
End Sub

Private Sub Class_Terminate()
InternetCloseHandle mHOpenFile
InternetCloseHandle mHFoundFile
InternetCloseHandle mHConnect
InternetCloseHandle mHInternet
End Sub

' ****
' Lets
' ****

Public Property Let DeleteFileName(ByVal vStrDeleteFileName As String)
mStrDeleteFileName = vStrDeleteFileName
AddNullChar mStrDeleteFileName
End Property

Public Property Let DirectoryName(ByVal vStrDirectoryName As String)
mStrDirectoryName = vStrDirectoryName
End Property

Public Property Let DownloadFileName(ByVal vStrDownLoadFileName As String)
mStrDownLoadFileName = vStrDownLoadFileName
AddNullChar mStrDownLoadFileName
End Property

Public Property Let FailIfExists(ByVal vBooFailIfExists As Boolean)
mBooFailIfExists = vBooFailIfExists
End Property

Public Property Let FindFileName(ByVal vStrFindFileName As String)
mStrFindFileName = vStrFindFileName
End Property

Public Property Let NewDownLoadFileName(ByVal vStrNewDownLoadFileName As
String)
mStrNewDownLoadFileName = vStrNewDownLoadFileName
End Property

Public Property Let NewUpLoadFileName(ByVal vStrNewUpLoadFileName As String)
mStrNewUpLoadFileName = vStrNewUpLoadFileName
AddNullChar mStrNewUpLoadFileName
End Property

Public Property Let Password(ByVal vStrPassWord As String)
mStrPassWord = vStrPassWord
End Property

Public Property Let ReadFileName(ByVal vStrReadFileName As String)
mStrReadFileName = vStrReadFileName
End Property

Public Property Let UpLoadFileName(ByVal vStrUpLoadFileName As String)
mStrUpLoadFileName = vStrUpLoadFileName
End Property

Public Property Let UserName(ByVal vStrUserName As String)
mStrUserName = vStrUserName
End Property

Public Property Let WriteFileName(ByVal vStrWriteFileName As String)
mStrWriteFileName = vStrWriteFileName
End Property

Public Property Let WriteBuffer(ByVal vStrWriteBuffer As String)
mStrWriteBuffer = vStrWriteBuffer
End Property

Public Property Let ServerName(ByVal vStrServerName As String)
mStrServerName = vStrServerName
End Property

' ****
' Gets
' ****

Public Property Get DeleteFile() As Boolean
DeleteFile = FtpDeleteFile(mHConnect, mStrDeleteFileName)
End Property

Public Property Get DownLoadFile() As Boolean
DownLoadFile = FtpGetFile(mHConnect, mStrDownLoadFileName,
mStrNewDownLoadFileName, mBooFailIfExists, 0, 0, 0)
End Property

Public Property Get FindFirstFile() As Long
FindFirstFile = FtpFindFirstFile(mHConnect, mStrFindFileName, mWFD,
0, 0)
If GetLastError() And ERROR_FTP_TRANSFER_IN_PROGRESS Then
InternetCloseHandle mHConnect
FindFirstFile = FtpFindFirstFile(mHConnect, mStrFindFileName,
mWFD, 0, 0)
End If
InternetCloseHandle mHFoundFile
mHFoundFile = FindFirstFile
End Property

Public Property Get FindNextFile() As Boolean
FindNextFile = InternetFindNextFile(mHFoundFile, mWFD)
If FindNextFile = 0 Then
If GetLastError() = ERROR_NO_MORE_FILES Then _
MsgBox "No More Files!", vbInformation, "FTP"
End If
End Property

Public Property Get FoundFileName() As String
FoundFileName = mWFD.cFileName
StripNullChar FoundFileName
End Property

Public Property Get GetCurrentDirectory() As String
Dim strBuffer As String
Dim lngBufferLength As Long
lngBufferLength = MAX_PATH
strBuffer = String(lngBufferLength - 1, " ")
If FtpGetCurrentDirectory(mHConnect, strBuffer, lngBufferLength) <>
0 Then
GetCurrentDirectory = Left(strBuffer, lngBufferLength)
End If
End Property

Public Property Get GetFileSize() As Long
GetFileSize = FtpGetFileSize(mHOpenFile, GetFileSize)
End Property

Public Property Get IsConnected() As Boolean
IsConnected = CBool(mHConnect)
End Property

Public Property Get OpenForRead() As Boolean
InternetCloseHandle mHOpenFile
mHOpenFile = FtpOpenFile(mHConnect, mStrReadFileName, GENERIC_READ,
FTP_TRANSFER_TYPE_BINARY, 0)
OpenForRead = (mHOpenFile <> 0)
End Property

Public Property Get OpenForWrite() As Boolean
InternetCloseHandle mHOpenFile
mHOpenFile = FtpOpenFile(mHConnect, mStrWriteFileName,
GENERIC_WRITE, FTP_TRANSFER_TYPE_BINARY, 0)
OpenForWrite = (mHOpenFile <> 0)
End Property

Public Property Get ReadBuffer()
ReadBuffer = mStrReadBuffer
End Property

Public Property Get ReadFromFile() As Long
Dim booRead As Boolean
Dim strReadBuffer As String
Dim lngReadBufferLength As Long
Dim lngBytesRead As Long
On Error GoTo ReadToFileErr
strReadBuffer = String(GetFileSize, " ") & vbNullChar
lngReadBufferLength = Len(strReadBuffer)
Do
booRead = InternetReadFile(mHOpenFile, strReadBuffer, _
lngReadBufferLength, lngBytesRead)
ReadFromFile = ReadFromFile + lngBytesRead
mStrReadBuffer = mStrReadBuffer & Left(strReadBuffer, lngBytesRead)
Loop Until lngBytesRead = 0 Or booRead = False
ReadToFileExit:
InternetCloseHandle mHOpenFile
Exit Property
ReadToFileErr:
Resume ReadToFileExit
End Property

Public Property Get SetCurrentDirectory() As Boolean
SetCurrentDirectory = (FtpSetCurrentDirectory(mHConnect,
mStrDirectoryName) <> 0)
End Property

Public Property Get UploadFile() As Boolean
UploadFile = FtpPutFile(mHConnect, mStrUpLoadFileName,
mStrNewUpLoadFileName, FTP_TRANSFER_TYPE_BINARY, 0)
End Property

Public Property Get WriteToFile() As Long
Dim booWrite As Boolean
Dim lngWriteBufferLength As Long
On Error GoTo WriteToFileExit
lngWriteBufferLength = Len(mStrWriteBuffer)
InternetWriteFile mHOpenFile, ByVal mStrWriteBuffer, _
lngWriteBufferLength, WriteToFile
WriteToFileExit:
InternetCloseHandle mHOpenFile
Exit Property
WriteToFileErr:
Resume WriteToFileExit
End Property

' ****
' subs
' ****

Public Sub ConnectToServer()
InternetCloseHandle mHConnect
mHConnect = InternetConnect(mHInternet, _
mStrServerName, _
INTERNET_DEFAULT_FTP_PORT, _
mStrUserName, _
mStrPassWord, _
INTERNET_SERVICE_FTP, 0, 0)
End Sub

Public Sub ShowLastResponseInfo()
Dim lngError As Long
Dim strError As String
Dim strBuffer As String
Dim lngBufferLength As Long
strBuffer = String(2047, " ") & vbNullChar
lngBufferLength = 2048
If InternetGetLastResponseInfo(lngError, strBuffer,
lngBufferLength) = 0 Then
MsgBox "Last response information could not be read!",
vbInformation, "FTP"
Else
If lngError <> 0 Then strError = " Error " & lngError
If lngBufferLength <> 0 Then _
MsgBox Left(strBuffer, lngBufferLength), vbInformation,
"FPT" & Nz(strError, "")
End If
End Sub
' ***********
' auxiliaries
' ***********

Private Sub AddNullChar(ByRef s As String)
If Right(s, 1) <> vbNullChar Then s = s & vbNullChar
End Sub

Private Sub StripNullChar(ByRef s As String)
Dim p As Long
p = InStr(s, vbNullChar)
If p <> 0 Then s = Left(s, p - 1)
End Sub

' **** end class ****

here's an implementation module I cobbled up this morning; one could not
call it "tested":

' **** begin implementation module ****

Option Explicit

Public Sub UploadFile( _
ByVal ServerName As String, _
ByVal LocalFilePathandName As String, _
Optional ByVal RemoteFileName As String, _
Optional ByVal Username As String, _
Optional ByVal Password As String, _
Optional ByVal RemotePath As String)

Dim DirectorySet As Boolean
Dim Uploaded As Boolean
Dim WorkingArray() As String

If Not DoesFileExist2000(LocalFilePathandName) Then
MsgBox "Can't find file " & LocalFilePathandName & vbNewLine &
"Exiting", vbCritical, "FFDBA"
Exit Sub
End If

Dim FTP As clsFTP '(the name of the class)
Set FTP = New clsFTP

With FTP
.ServerName = ServerName

If Len(Username) = 0 Then
Username = InputBox("User Name", "FFDBA")
End If
If Len(Password) = 0 Then
Password = InputBox("PassWord", "FFDBA")
End If
.Username = Username
.Password = Password

If Len(RemoteFileName) = 0 Then
WorkingArray = Split(Replace(LocalFilePathandName, "/", "\"), "\")
RemoteFileName = WorkingArray(UBound(WorkingArray))
End If

.ConnectToServer

If .IsConnected Then
DirectorySet = True
If Len(RemotePath) > 0 Then
.DirectoryName = RemotePath
DirectorySet = .SetCurrentDirectory
End If

If DirectorySet Then
.UpLoadFileName = LocalFilePathandName
.NewUpLoadFileName = RemoteFileName
Uploaded = .UploadFile
End If
Else
MsgBox "Could Not Connect To " & ServerName, vbCritical, "FFDBA"
End If

.ShowLastResponseInfo

End With

Set FTP = Nothing
End Sub

Private Function DoesFileExist2000(ByVal FilePath As String) As Boolean
With WizHook
.Key = 51488399
DoesFileExist2000 = .FileExists(FilePath)
End With
End Function

Sub test()
' some servers seem to require "/subfolder" while others require
"subfolder"
UploadFile "ffdba.com", "/IMG_0414.JPG", "Neys.jpg", , , "4060148"
End Sub

Sub test()
' some servers seem to require "/subfolder" while others require
"subfolder"
UploadFile "ffdba.com", "/IMG_0414.JPG", "Neys.jpg", , , "4060148"
End Sub

Sub test2()
' some servers seem to require "/subfolder" while others require
"subfolder"
UploadFile "ftp.cogeco.ca", "/IMG_0414.JPG", "Neys2.jpg", , ,
"/October"
End Sub

'**** end implementation module ****
************************************************** *********************
This does the same job as ALL THE CRUD above for FrontPage or IIS sites.
It's simpler, faster, smaller, prettier and crashes less often.

Public Sub ADOUploadFile( _
ByVal FromPath As String, _
ByVal ToFile As String, _
ByVal Server As String)
Dim r As ADODB.Record
Dim s As ADODB.Stream
Set r = New ADODB.Record
Set s = New ADODB.Stream
r.Open Server & "/" & ToFile, , adModeWrite, adCreateOverwrite
With s
.Open r, , adOpenStreamFromRecord
.Type = adTypeBinary
.LoadFromFile FromPath
.Close
End With
r.Close
End Sub

Sub ADPTest()
ADOUploadFile "c:\IMG_0414.JPG", "neys2.jpg",
"http://ffdba.com/4060148"
End Sub

[Danny J. Lesandrini]

Did you check out my article ... and free code download?

http://www.databasejournal.com/featu...le.php/3513061

--

Danny J. Lesandrini
dl*********@hotmail.com
http://amazecreations.com/datafast/

"Lauren Wilson" <no****@none.com> wrote in message news:lq********************************@4ax.com...

Thanks again Kyle. I get the message. I did not realize the code was
limited to FP and IIS stuff. I now must re-state my original
intentions for this thread:

I simply want to do the following tasks with code from VBA:

1. Connect to a Microsoft 2003 Server via FTP -- in a specific folder.
2. Retrieve a list of all *.MDB files and display them to the user so
the user can select ONE file for download.
3. Download the user's selected file
4. Validate the completed download, then delete the retrieved file
from the server.
5. Close the FTP session

Later, I will want to reverse the process and UPLOAD selected files to
the user's folder on the same server.

I seem to have gotten lost in a blizzard of suggested ways to do this.
Can you or anyone else clarify it in light of my task list above?

Thanks folks. Appreciate you tolerating my extreme ignorance about
this area of VBA work.

--LW

[lylefair]

Doing everything you want with FTP or ADO may require several hours of
code wiritn and trial and error.

Perhaps there are simpler solutions (these go to real test sites; I
have tired them on two computers using Windows XP).

Public Sub FTPviaExplorer()
Dim s As Object
Set s = CreateObject("Shell.Application")
With s
.Explore "ftp://testftp%40cogeco.ca:Pa******@ftp.cogeco.ca"
End With
Set s = Nothing
End Sub

Public Sub BrowseForDonload()
Application.FollowHyperlink "http://home.cogeco.ca/~testftp"
End Sub

Sub PseudoEscape()
Debug.Print "%" & Hex(Asc("@"))
Debug.Print "%" & Hex(Asc("."))
End Sub

'Notes
' some browsers may require non alpha-numeric characters as
' the "%" character plus the ascii value of the character
' expressed in base 16 (hex)
' thus "@" goes to %40
' and "." would go to %2E
' in the username only.

' note that string after the "~" is case sensitive
' try
' Application.FollowHyperlink "http://home.cogeco.ca/~testFTP"
' if you need convincing

[Lauren Wilson]

On Sun, 9 Oct 2005 05:56:42 -0600, "Danny J. Lesandrini"
<dl*********@hotmail.com> wrote:

Did you check out my article ... and free code download?

http://www.databasejournal.com/featu...le.php/3513061

Yes I did Danny. Dear fellow, you are very kind -- and talented!

I did extensive testing on your FTP form. I believe it WILL be the
ultimate solution.

However, I did run into a problem that I reported to you via email. I
suspect you did not see one or more of my emails. Thus, I will post
the critical one here in hope of a detailed response:

======================= BEGIN PREVIOUS EMAIL ================
Hi Danny,

I am so sorry to bother you with this but I'm not sure where to start.

Dear fellow, I am on a crash and burn deadline and I'm having a
perplexing problem with your cool FTP form.

If you would be so kind, I would be very grateful if you at least give
me a hint about this problem.

When I run your form with the default connection settings, I get the
following content in the "FileList.txt" file:

10-02-05 07:08AM 41 2005-10-02.txt
10-03-05 10:33AM 41 2005-10-03.txt
09-29-05 08:29AM 173 download.scr
10-03-05 09:15PM 42 JustForKicks.txt
09-24-05 01:03AM 29 ltowne.txt
09-29-05 04:22PM 1727 STAR_ELIG.txt
09-24-05 01:03AM 190 upload.scr
09-24-05 01:17AM 28 user1.txt
10-03-05 09:03AM 30 williak.txt
However, when I change the connection info to our [MS 2003] server
settings, I get the following content in the "FileList.txt" file:

-rw-r--r-- 1 ftp ftp 692224 Sep 29 01:02 jrosanbalm.mdb
-rw-r--r-- 1 ftp ftp 249856 Sep 27 15:14 MalibNat_50.mdb

Obviously, your code does not expect this different structure and it
places the data in the wrong columns of the sub form. I have no idea
(yet) why the file list data is delivered in a different format than
your form expects.

Do you know why the two file retrievals produce different structures
and what I can QUICKLY do about it?

Many thanks for your prompt reply Danny.

--Lauren Wilson
======================= END PREVIOUS EMAIL ================

Obviously, I CAN modify the retrieval code. However, before I do it,
I would appreciate you pointing me to the exact sub that performs the
formatting. I'm on such a critical deadline, that any expediency you
can provide would be greatly appreciated.

[David W. Fenton]

"lylefair" <ly***********@aim.com> wrote in
news:11**********************@g14g2000cwa.googlegr oups.com:

Doing everything you want with FTP or ADO may require several
hours of code wiritn and trial and error.

Perhaps there are simpler solutions (these go to real test sites;
I have tired them on two computers using Windows XP).

Public Sub FTPviaExplorer()
Dim s As Object
Set s = CreateObject("Shell.Application")
With s
.Explore "ftp://testftp%40cogeco.ca:Pa******@ftp.cogeco.ca"
End With
Set s = Nothing
End Sub

Public Sub BrowseForDonload()
Application.FollowHyperlink "http://home.cogeco.ca/~testftp"
End Sub

Sub PseudoEscape()
Debug.Print "%" & Hex(Asc("@"))
Debug.Print "%" & Hex(Asc("."))
End Sub

'Notes
' some browsers may require non alpha-numeric characters as
' the "%" character plus the ascii value of the character
' expressed in base 16 (hex)
' thus "@" goes to %40
' and "." would go to %2E
' in the username only.

' note that string after the "~" is case sensitive
' try
' Application.FollowHyperlink "http://home.cogeco.ca/~testFTP"
' if you need convincing

What, exactly, is the code supposed to do? How does this accomplish
the task Lauren has ahead of her?

In any event, when I open the link in my browers, I get 404 Error
Not Found.

And is this a Cogent server? Cogent has been completely inaccessible
to much of the Internet for the last week or so because of a
disagreement with Level3 over peering. L3 has just restored
connectivity in the last 24 hours for a grace period of one month to
allow Cogent subscribers to make alternate arrangements for
multi-homing should Cogent choose not to pay L3 for transit.

But the server is definitely accessible right now and the URL you
gave is coming up 404.

I am interested, though, in what you were intending to demonstrate.
If it was the idea that this kind of thing could be done with
server-side scripts, you may be right, but it certainly doesn't
reduce the amount of work required.

--
David W. Fenton http://www.bway.net/~dfenton
dfenton at bway dot net http://www.bway.net/~dfassoc

[lylefair]

Did you open this link:
http://www.google.com/url?sa=D&q=htt...co.ca/~testftp
or this one
http://www.google.com/url?sa=D&q=htt...co.ca/~testFTP
?
As I explained the second one cannot be found because characters after
the tilde (~) are case-sensitive.
****
As for ftp://testftp%40cogeco.ca:Pa******@ftp.cogeco.ca; one cannot
paste it as a link; one can use it in Application.FollowHyperLink.
To paste as a link one must use:
ftp://te*****@cogeco.ca:Pa******@ftp.cogeco.ca