Forum Moderators: open

Message Too Old, No Replies

MSAccess and FTP

MSAccess, FTP

         

daltman1967

6:51 pm on May 27, 2009 (gmt 0)

10+ Year Member



I recently downloaded a great script for sending files to FTP from within the VBA code of MSAccess. It seems to send one file ok, but not "*.*" ... I'm stuck on that. The other thing is, I can't seem to find how to delete files. Anyone got any help for this?

Here is the code, in part:

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) 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 & ")", 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

'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

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