Public Sub UploadWithStatus()

The below sample will upload a file called c:\temp\test.txt to a file called /usr/home/david/testfile.txt on ftp server ftp.codeoftheweek.com

   Set ftp = New cFTP
   ftp.DestinationFilename = "/usr/home/david/testfile.txt"
   ftp.SourceFilename = "c:\temp\test.txt"
   ftp.ServerName = "ftp.codeoftheweek.com"
   ftp.Username = "user"
   ftp.Password = "password"
   On Error Resume Next
   ftp.UploadWithStatus
   If Err Then
      MsgBox Err.Description
   End If

You should name this class module cFTP. If you have any questions, email us at help@codeoftheweek.com

'----------------------------------------------------------------------
'
'   Module Name:    cFTP
'   Written By:     C&D Programming Corp.
'   Create Date:    9/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit


'
'  BE SURE TO INCLUDE THE SOURCE FROM ISSUE #55 and
'  #56 FOR COMPLETE FUNCTIONALITY.
'
'  http://www.codeoftheweek.com/membersonly/bi/0055.html
'  http://www.codeoftheweek.com/membersonly/bi/0056.html
'

Private Declare Function InternetWriteFile Lib "wininet.dll" _
        (ByVal hFile As Long, ByVal sBuffer As String, _
        ByVal lNumberOfBytesToWrite As Long, _
        lNumberOfBytesWritten As Long) As Integer


Public Sub UploadWithStatus()
    Dim bRet As Boolean
    Dim sFileRemote As String
    Dim sDirRemote As String
    Dim sFileLocal As String    ' the local filename
    Dim lDataType As Long       ' data type to transfer the file with binary/ascii
    Dim lPos As Long

    On Error GoTo Handler

    '
    ' Do some data validation on the source filename and
    ' the destination filename
    '
    If SourceFilename = "" Then
        Err.Raise 5, "cFTP.UploadWithStatus", _
                "You must specify a source filename, such as c:\Upload\filename.zip"
    End If
    If Dir(SourceFilename) = "" Then
        Err.Raise 53, "cFTP.UploadWithStatus", "The file " & SourceFilename & " does not exist."
    End If

    If Trim$(DestinationFilename) = "" Then
        Err.Raise 5, "cFTP.UploadWithStatus", _
                "You must specify a filename to store the Uploaded data, such as /public/filename.zip"
    End If

    '
    ' try to connect to server.  If we can't connect, raise an error.
    '
    ConnectToServer

    ' break apart filename for passing to the Ftp call
    ' we need to do this because the Ftp call will not
    ' automatically change the directory on the ftp server.  So,
    ' we first have to determine the directory and then do a
    ' remote change directory call to position the ftp server
    ' to the correct place.  After this, we can successfully
    ' transfer the files.
    sFileRemote = DestinationFilename
    lPos = FindLastOccurrence(sFileRemote, "/")
    sDirRemote = Left(sFileRemote, lPos)
    sFileRemote = Right(sFileRemote, Len(sFileRemote) - lPos)
    sFileLocal = SourceFilename

    ' change remote directory to sDirRemote
    RemoteChangeDir sDirRemote

    ' set the data transfer mode
    If BinaryMode Then
        lDataType = FTP_TRANSFER_TYPE_BINARY
    Else
        lDataType = FTP_TRANSFER_TYPE_ASCII
    End If

    Dim sData As String             ' to get data from the net
    Dim lNumberOfBytesWritten As Long  ' number of bytes written by the InternetWriteFile routine
    Dim curTotalBytes As Currency   ' total number of bytes read for this call
    Dim hFile As Long               ' file handle to use in InternetReadFile
                                    ' this is a pointer to the remote file
    Dim curFileSize As Currency     ' to hold the filesize of the file about to
                                    ' be transferred
    Dim iInFile As Integer          ' Handle for input file

    ' retrieve the file size if possible, returns -1 if it can not be
    ' determined
    curFileSize = FileLen(sFileLocal)

    ' open destination file
    iInFile = FreeFile
    On Error Resume Next
    Open sFileLocal For Binary As iInFile
    If Err Then
        DisconnectFromServer
        TerminateSession
        Err.Raise Err.Number, "cFTP.UploadWithStatus", "Could not open input file: " & sFileLocal & vbCrLf & "Error was " & Err.Description
    End If
    On Error GoTo Handler

    ' open file and force it to be loaded from the network, even if it is
    ' already cached.
    hFile = FtpOpenFile(mhConnection, sFileRemote, GENERIC_WRITE, _
                        lDataType Or INTERNET_FLAG_RELOAD, vbNull)

    ' init our counter and buffer
    curTotalBytes = 0

    ' loop until there is no more data to be written
    Do
        ' if the size of the file is less than one BufferSize then just send it.
        If LOF(iInFile) <= BufferSize Then
            sData = Input(LOF(iInFile) - 1, iInFile)
        Else
            If Loc(iInFile) + BufferSize > LOF(iInFile) Then
                sData = Input(LOF(iInFile) - Loc(iInFile) + 1, iInFile)
            Else
                sData = Input(BufferSize, iInFile)
            End If
        End If
        bRet = InternetWriteFile(hFile, sData, Len(sData), _
                                lNumberOfBytesWritten)
        If Not bRet Then
            Dim lError As Long
            Dim sErrorData As String
            sErrorData = String(1024, " ")
            InternetGetLastResponseInfo lError, sErrorData, Len(sErrorData) - 1
        End If

        RaiseEvent TransferProgress(lNumberOfBytesWritten, curTotalBytes, curFileSize)
        curTotalBytes = curTotalBytes + lNumberOfBytesWritten
    Loop Until EOF(iInFile)

    Close iInFile

    RaiseEvent TransferComplete(curTotalBytes)

    ' close of file handle for FTP file
    InternetCloseHandle hFile

    If bRet Then
        DisconnectFromServer
        TerminateSession
    Else
        Err.Raise Err.LastDllError, "cFTP.UploadWithStatus", ErrorMessage(Err.LastDllError)
    End If
    Exit Sub

Handler:
    If Err Then
        Err.Raise 5, "cFTP.UploadWithStatus", "Trying to Upload file from " & ServerName & "." & vbCrLf & vbCrLf & "Error Message: " & Err.Description
        Exit Sub
    End If
    Err.Raise Err.Number, "cFTP.UploadWithStatus", Err.Description
    Resume
End Sub