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