[AccessD] FTP From Access

DWUTKA at marlow.com DWUTKA at marlow.com
Mon May 22 18:44:18 CDT 2006


Put the following in a class module and save it. (I call it FTPSite):

Option Explicit
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias
"FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As
String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal
dwContent As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias
"InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As
String, ByVal nServerPort As Integer, ByVal sUsername As String, ByVal
sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal
lContext As Long) As Long
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias
"InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As
WIN32_FIND_DATA) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet
As Long) As Integer
Private Declare Function InternetOpen Lib "wininet.dll" Alias
"InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal
sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As
Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As
FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA"
(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As Long,
ByVal Flags As Long, ByVal Context As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As
Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long,
lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetWriteFile Lib "wininet.dll" (ByVal hFile As
Long, ByRef sBuffer As Byte, ByVal lNumBytesToWrite As Long,
dwNumberOfBytesWritten As Long) As Integer
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(Destination As Any, Source As Any, ByVal Length As Long)

Private Const MAX_PATH = 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 Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer

End Type
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_FLAG_TRANSFER_BINARY = &H2
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const INTERNET_FLAG_PASSIVE = &H8000000
Public SiteName As String
Public Port As Long
Public UserName As String
Public Password As Variant
Public NewestFile As Date
Dim blConnected As Boolean
Dim hOpen As Long
Dim hConnect As Long
Dim hFile As Long
Dim f As Long
Dim int10KDownloaded As Long
Dim blPause As Boolean
Dim blCancel As Boolean
Dim blDeleteDownloadedFile As Boolean
Dim FTPFiles As Collection
Dim SaveFilePath As String
Event ConnectionStateChange()
Event FTPError(strErrorMessage As String)
Const intChunkSize As Long = 10240
Event StartingDownload()
Event ProgressAlert(intTenthsDownloaded As Long)
Event DownloadComplete(intTotalTenths As Long, blCanceled As Boolean)
'Event AllFilesUnzipped()
Event UnzippingFile(strFileName As String)
Event FileUnzipped(strFileName As String)
Public AllFilesUnzipped As Boolean
Public Function StartingUnzip(strFileName As String)
RaiseEvent UnzippingFile(strFileName)
End Function

Public Function CloseUploadFile()
InternetCloseHandle hFile
End Function
Public Function UploadData(ByVal strData As String)
Dim intBuffer As Long
Dim dwReturn As Long
Dim intLen As Long
'Dim strTemp As String
Dim byteBuffer() As Byte
'strTemp = strData
intLen = Len(strData)
ReDim byteBuffer(0 To intLen - 1)
CopyMemory byteBuffer(0), ByVal strData, intLen
dwReturn = InternetWriteFile(hFile, byteBuffer(0), intLen, intBuffer)
End Function
Public Function StartUploadFile(strNewName As String)
If Not blConnected Then Connect
    hFile = FtpOpenFile(hConnect, strNewName, GENERIC_WRITE, 2, 0)
End Function
Property Get Paused() As Boolean
Paused = blPause
End Property
Property Get FileCount() As Long
FileCount = FTPFiles.Count
End Property
Property Get Connected() As Boolean
Connected = blConnected
End Property
Public Function Connect()
hOpen = InternetOpen("Dean File Upload Testing",
INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If hOpen = 0 Then
    RaiseEvent FTPError("Error with InternetOpen")
Else
    hConnect = InternetConnect(hOpen, SiteName, Port, UserName, Password,
INTERNET_SERVICE_FTP, 0, 0)
    'hConnect = InternetConnect(hOpen, SiteName, Port, UserName, Password,
INTERNET_SERVICE_FTP, 0, 0)
    If hConnect = 0 Then
        RaiseEvent FTPError("Error with InternetConnect")
    Else
        blConnected = True
        RaiseEvent ConnectionStateChange
        DoEvents
    End If
End If
End Function
Public Function Disconnect()
If hConnect <> 0 Then InternetCloseHandle hConnect
If hOpen <> 0 Then InternetCloseHandle hOpen
If blConnected Then
    blConnected = False
    RaiseEvent ConnectionStateChange
End If
End Function
Private Sub Class_Initialize()
'RestoreToStoredSettings
Set FTPFiles = New Collection
blPause = False
blCancel = False
blDeleteDownloadedFile = False
AllFilesUnzipped = False
End Sub
Private Sub Class_Terminate()
Disconnect
Set FTPFiles = Nothing
End Sub

TO run this, the code would be something like this:

Dim fSite As FTPSite
Dim strTemp As String
Set fSite = New FTPSite
fSite.Connect
fSite.SiteName="ftp.whateveryourftpserveris.com"
fSite.Port=21 'this is the usual FTP port
fSite.UserName="whateverusername"
fsite.Password="whateverpassword"
fSite.StartUploadFile "File name you want on the ftp server.txt"
strTemp="you would set strtemp to the data you want to upload....."
fSite.UploadData strTemp
fSite.CloseUploadFile
Set fSite = Nothing


A few notes on this.  FTPSite's 'UploadData' function can be used over and
over.  So, for example, let's say you want to upload the data from a
recordset.  You could put fSite.UploadData in the loop, looping through the
fields (putting in a delimiter after each field) and looping through
records.  

If you are uploading a lot of data, you can break it up, and have a
'progress' indication going as you are uploading chunks.  If you try sending
a few megs at once, the code is going to pause a while at that command,
where as a few k at a time go pretty fast (depending on the connection)

Drew

-----Original Message-----
From: Rocky Smolin - Beach Access Software [mailto:bchacc at san.rr.com] 
Sent: Monday, May 22, 2006 3:51 PM
To: Access Developers discussion and problem solving
Subject: [AccessD] FTP From Access

Dear List:

What is the quickest, easiest, and./or fastest way to FTP something from 
Access to a website?

MTIA

Rocky

-- 
Rocky Smolin
Beach Access Software
858-259-4334
www.e-z-mrp.com

-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com



More information about the AccessD mailing list