Access Front for FTP Upload to Offsite Server 1

[sard0nicpan]

Happy Friday,

Presently, my company has been manually uploading PDF's and other documents to an offsite repository for storage. I'd like to automate the process and integrate it with our own database with an Access front-end(Access 2000). I have all the background info on the formatting that the remote server needs, so that part is easy. What I believe I need is an add-in to Access that will make the FTP upload possible. Am I right in this assumption?

Does anyone have any suggestions? A freeware add-in would be preferable since requisitioning here is a drag. However, an add-in with a free trial period may be helpful to demonstrate the advantages of the process (hopefully making the request for purchase go through). Any Ideas, or products which you like?

Tony

 

[sard0nicpan]

1MDF,

I have to declare ignorance on that one. However, I will take you up on your offer on the code for using wininet.dll.

I'm sure others who have participated in this thread would like to see it also.

Funny, but this thread sort of surprised me by not dying out. When someone posted to it about a week ago I actually did not remember starting this thread back in February. Obviously it's a common problem.

Regards,

SP

 

[1DMF]

no probs, for all those who need to upload a file from local machine to remote FTP, here's how you do it....

I'm not sure of the best place to put all the code , that's best left to your own judgement relative to your project , i've just indicated where I put it...

Top of Project (Global Code) define these constants...

Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const PassiveConnection As Boolean = True

Top of Project (Global Code) declare these functions...

Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
(ByVal hconnect As Long, ByVal lpszLocalFile As String, ByVal _
lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) _
As Boolean

Declare Function FtpOpenFile Lib "wininet.dll" (ByVal hconnect As Long, ByVal lpszFileName As String, _
 ByVal fdwAccess As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean

Declare Function InternetWriteFile Lib "wininet.dll" (ByVal hconnect As Long, ByVal lpBuffer As Long, _
 ByVal dwNumberOfBytesToWrite As Long, ByVal lpdwNumberOfBytesWritten As Long) As Boolean

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

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

Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias _
"InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As _
String, lpdwBufferLength As Long) As Boolean

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

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

I then wrote this function for my purposes...

Function UploadFile(ByVal HostName As String, _
    ByVal UserName As String, _
    ByVal Password As String, _
    ByVal LocalFileName As String, _
    ByVal RemoteFileName As String, _
    ByVal sDir As String) As Boolean
    
    Dim hConnection, hOpen  As Long

 ' 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)
' Upload file
UploadFile = FtpPutFile(hConnection, LocalFileName, RemoteFileName, FTP_TRANSFER_TYPE_ASCII, 0)
           
 'ShowError - commented out as I don't want to show last returned message


' Close Connection
Call InternetCloseHandle(hOpen)
Call InternetCloseHandle(hConnection)

End Function

Then to send the file i call the routine like so...the function returns boolean true/false so you can capture successfull upload easily

UploadFile("ftp.domain.com", "userid", "password", "Full path and file name of local file", "remote filename", "path on remote server to use")

If you want to display the results from the upload function with "show error" you will need this function..

Sub ShowError()
   Dim lErr As Long, sErr As String, lenBuf As Long
   'get the required buffer size
   InternetGetLastResponseInfo lErr, sErr, lenBuf
   'create a buffer
   sErr = String(lenBuf, 0)
   'retrieve the last respons info
   InternetGetLastResponseInfo lErr, sErr, lenBuf
   'show the last response info
   MsgBox "Error " + CStr(lErr) + ": " + sErr, vbOKOnly + vbCritical
End Sub

Please note I have set the upload function to upload in ASCII you can change this easily by using the constant for BINARY, or even add an additional parameter to the function and pass it the mode you require and place an if statement around the connection code.

also as I am looping a record set for multiple files you can use the status bar indicator for a progress meter with these commands..

SysCmd(acSysCmdInitMeter, "Text you want to display", File Length / 1000)
SysCmd(acSysCmdUpdateMeter, amount to add / 1000)
SysCmd(acSysCmdRemoveMeter)

Let me put that into context by supplying the code I have using it..

this uploads a bunch of html docs which are statements for our members accounts.

Private Sub Process_Click()

Dim rs As Recordset
Dim sFile As String
Dim FileLength As Long
Dim RetVal As Variant
Dim iCnt As Long
Dim iFlen As Long

On Error GoTo Err_Process_Click

'Are You Sure
If vbNo = MsgBox("Process ALL statements for ALL Members, Are you sure?", vbYesNo) Then
   Exit Sub
End If

'get list of statements for processing
Set rs = CurrentDb.OpenRecordset("SELECT * FROM [Statements]", dbOpenDynaset, dbSeeChanges)

' set counters
FileLength = 0
iCnt = 0

' loop each record and determine file size
Do While Not rs.EOF
    ' set full path and file name
    sFile = "C:\Commissions\Statements\" & rs.Fields("DocID") & ".htm"
    'if file exists
    If Len(Trim(Dir(sFile))) > 0 Then
        ' get file length and add to total file size
        FileLength = FileLength + FileLen(sFile) 
    End If
    rs.MoveNext
Loop

'set progress meter with total file size
RetVal = SysCmd(acSysCmdInitMeter, "Uploading Statements", FileLength / 1000)
'reselect all statements and upload
Set rs = CurrentDb.OpenRecordset("SELECT * FROM [Statements]", dbOpenDynaset, dbSeeChanges)
Do While Not rs.EOF
        ' set full path and file name
        sFile = "C:\Commissions\Statements\" & rs.Fields("DocID") & ".htm"
        ' if file exists
        If Len(Trim(Dir(sFile))) > 0 Then
            ' add file size to progress counter
            iCnt = iCnt + FileLen(sFile)
            ' update progress meter
            RetVal = SysCmd(acSysCmdUpdateMeter, iCnt / 1000)
            ' if upload successfull - returns boolean true/false
            If (UploadFile("ftp.mydomain.com", "myuser", "mypassword", sFile, rs.Fields("DocID") & ".htm", "/my/docs/path")) Then
                MsgBox "this would update statement file and move to history"
            Else
                MsgBox "Statement ( " & rs.Fields("DocID") & ".htm ) - Upload Failed!"
            End If
                
        Else
            MsgBox "Statement ( " & rs.Fields("DocID") & ".htm ) - Is Missing!"
        End If
    End If
    
rs.MoveNext
        
Loop

rs.Close

Set rs = Nothing

' remove progress bar
RetVal = SysCmd(acSysCmdRemoveMeter)

Exit_Process_Click:
    Exit Sub

Err_Process_Click:
    MsgBox "Error in Process_Click : " & Err.Description
    Resume Exit_Process_Click
    
End Sub

hope that all makes sense
PLEASE NOTE!

The target remote directory path must exist on server - i haven't written it to create a folder, if you search the net, there are further examples of additional delcare functions in the wininet.DLL you can use for creating, deleting etc.. this is purely for uploading ASCII files via PASSIVE MODE TRANSFER to a remote FTP server and to a folder that already exists!

Hope you have fun with it and it helps someone to achieve their FTP goals,

 

[1DMF]

opps i just noticed that there is an extra end if in the process_click() code

shows ....

            MsgBox "Statement ( " & rs.Fields("DocID") & ".htm ) - Is Missing!"
        End If
    End If
    
rs.MoveNext

should be...

            MsgBox "Statement ( " & rs.Fields("DocID") & ".htm ) - Is Missing!"
        End If
    
rs.MoveNext

sorry!

 

[sard0nicpan]

1DMF,

Thanks much . . .

I'll probably take a closer look at it after the weekend. For now, I have my mind on BBQ and ETOH. I'm looking forward to doing some heavy damage, lol!

SP

 

[1DMF]

ETOH - ? not sure what that means - but the BBQ and "Heavy Damage" sounds fun!

I hope you find the code helpfull

Have a good one.

1DMF

 

[sard0nicpan]

ETOH = alcohol

SP