Upload a file to FTP Server

Allow me to offer a solution that I use to see if it works for you.  It works for me in Office 2003, 2007, 2010, and in Windows XP and windows 7.

the idea behind this solution is that it bypasses Windows and uses a standard FTP tool that is readily available from a DOS window.

In its simplest version, you create a batch file to perform the transfer, then run the batch file.

To run these you will need to open VB in Excel and add a new Module and paste this code there:

 

Public Const vbQuote As String = """"

Private Function CreateFTPInputFile(FTPBatchFileName As String, _
    Optional LocalDownloadPath As String = "C:\", _
    Optional ServerPath As String = "/", _
    Optional RemoteProductionFileName As String = "old.out", _
    Optional RemoteTestFileName As String = "new.out" _
    ) As Boolean
    On Error GoTo CreateFTPInputFile_Err
    
    Dim bFileCreated As Boolean
    Dim iAnswer As Integer
    Dim iFileNumber As Integer
    Dim strDownloadPath As String
    Dim strDownloadFile1 As String
    Dim strDownloadFile2 As String
    Dim strDownloadFilePath1 As String
    Dim strDownloadFilePath2 As String
    Dim strExistingFileName1 As String
    Dim strExistingFileName2 As String
    Dim strFileFoundMessage As String
    Dim strDownloadPathMessage As String
    
    'FileType =0 output, 1=input
    
    bFileCreated = False
    
    strDownloadPath = LocalDownloadPath
    strDownloadFile1 = RemoteProductionFileName
    strDownloadFile2 = RemoteTestFileName
    
    If Right$(strDownloadPath, 1) <> "\" Then
        strDownloadPath = strDownloadPath & "\"
    End If
    
    strDownloadFilePath1 = strDownloadPath & strDownloadFile1
    strDownloadFilePath2 = strDownloadPath & strDownloadFile2
    
    strExistingFileName1 = Dir$(strDownloadFilePath1)
    strExistingFileName2 = Dir$(strDownloadFilePath2)
    If strExistingFileName1 = vbNullString _
    And strExistingFileName2 = vbNullString Then
        iAnswer = vbYes
    Else
        If strExistingFileName1 = vbNullString Then
            strFileFoundMessage = strExistingFileName2
        ElseIf strExistingFileName2 = vbNullString Then
            strFileFoundMessage = strExistingFileName1
        ElseIf strExistingFileName1 = strExistingFileName2 Then
            strFileFoundMessage = strExistingFileName1
        Else
            strFileFoundMessage = strExistingFileName1 & " and " & strExistingFileName2
        End If
        
        strDownloadPathMessage = strDownloadFilePath1
        If strDownloadFilePath1 <> strDownloadFilePath2 Then
            strDownloadPathMessage = strDownloadPathMessage & vbNewLine & strDownloadFilePath2
        End If
        iAnswer = MsgBox("The path/file exists for " & strFileFoundMessage & ". Overwrite it?" & vbNewLine & strDownloadPathMessage, vbYesNo Or vbQuestion)
    End If
    
    If iAnswer = vbYes Then
        iFileNumber = FreeFile()
        Open FTPBatchFileName For Output As #iFileNumber
        
        Print #iFileNumber, "lcd " & vbQuote & Left$(strDownloadPath, Len(strDownloadPath) - 1) & vbQuote
        'Print #iFileNumber, "cd " & vbQuote & ServerPath & vbQuote 'Me.txtServerPath.Value & vbQuote
        Print #iFileNumber, "cd " & ServerPath
        Print #iFileNumber, "get " & vbQuote & strDownloadFile1 & vbQuote
        Print #iFileNumber, "get " & vbQuote & strDownloadFile2 & vbQuote
        Print #iFileNumber, "pwd" ' force message to confirm process completion in "WaitForFTPToComplete"
        Print #iFileNumber, "close"
        Print #iFileNumber, "quit"
        Close #iFileNumber
        bFileCreated = True
    End If
    
CreateFTPInputFile_Exit:
    CreateFTPInputFile = bFileCreated
    Exit Function
    
CreateFTPInputFile_Err:
    MsgBox Err.Description
    Resume CreateFTPInputFile_Exit
End Function

Private Function CreateFTPOutputFile(FTPBatchFileName As String, _
    Optional LocalClaimPath As String = "C:\", _
    Optional LocalClaimFileName As String = "1claim.dat", _
    Optional ServerPath As String = "/", _
    Optional ServerClaimFileName As String = "1claim.dat" _
    ) As Boolean
    On Error GoTo CreateFTPOutputFile_Err
    
    Dim bFileCreated As Boolean
    Dim iFileNumber As Integer
    Dim strUploadPath As String
    Dim strUploadFile As String
    Dim strUploadFilePath As String
    
    'FileType =0 output, 1=input
    bFileCreated = False
    
    strUploadPath = LocalClaimPath
    strUploadFile = LocalClaimFileName
    
    If Right$(strUploadPath, 1) <> "\" Then
        strUploadPath = strUploadPath & "\"
    End If
    
    strUploadFilePath = strUploadPath & strUploadFile
    
    If Dir$(strUploadFilePath) = vbNullString Then
        MsgBox "The path/file is invalid or does not exist and cannot be processed:" & vbNewLine & strUploadFilePath, vbOKOnly Or vbExclamation
        'Me.txtLocalClaimFileName.SetFocus
        'exit sub
    Else
        iFileNumber = FreeFile()
        Open FTPBatchFileName For Output As #iFileNumber
        
        Print #iFileNumber, "cd " & ServerPath
        'Print #iFileNumber, "del " & ServerClaimFileName
        Print #iFileNumber, "put " & vbQuote & strUploadFilePath & vbQuote
        If strUploadFile <> ServerClaimFileName Then 'Me.txtServerClaimFileName.Value Then
            Print #iFileNumber, "rename " & strUploadFile & " " & ServerClaimFileName
        End If
        Print #iFileNumber, "pwd" ' force message to confirm process completion in "WaitForFTPToComplete"
        Print #iFileNumber, "close"
        Print #iFileNumber, "quit"
        Close #iFileNumber
        bFileCreated = True
    End If
    
CreateFTPOutputFile_Exit:
    CreateFTPOutputFile = bFileCreated
    Exit Function
    
CreateFTPOutputFile_Err:
    MsgBox Err.Description
    Resume CreateFTPOutputFile_Exit
End Function

Select allOpen in new window

with those functions in place you can then call them from other procedures...
Note that for my usage, I had to transfer 2 files so I set it up for that, but it could have been changed to FTP one file at a time then call it twice.

You'll also need to add a reference to the File System Object (Microsoft Scripting Runtime, scrrun.dll).

And add this to the same module:

Public Enum FTPDirection
    FTPPut = 0
    FTPGet = 1
End Enum

Public Function RunFTPBatchFile(FTPBatchFileName As String, FileType As FTPDirection, _
    Optional LocalClaimPath As String = "C:\", _
    Optional LocalClaimFileName As String = "localfile.txt", _
    Optional RemotePath As String = "/remotedir", _
    Optional RemoteClaimFileName As String = "remotefile.txt", _
    Optional RemoteProductionFileName As String = "old.out", _
    Optional RemoteTestFileName As String = "new.out", _
    Optional ServerLoginName As String = "loginname", _
    Optional ServerName As String = "servername", _
    Optional ServerPassword As String = "password", _
    Optional ReturnYesNoResponse As Boolean = False, _
    Optional AdditionalMessage As String = vbNullString _
    ) As Boolean
    On Error GoTo RunFTPBatchFile_Err
    
    Dim strTempFolderPath As String
    Dim strFTPMessage As String
    Dim bContinueProcessing As Boolean
    Dim strWindowOpenStatus As String
    Dim strTransferredFileAndPath As String
    Dim strFullFTPCommandLine As String
    Dim iFileNumber As Integer
    Dim dblWindowID As Double
    Dim bTransferCompleted As Boolean
    Dim strTransferDirection As String
    Dim bRunFTPBatchFile As Boolean
    Dim fso As FileSystemObject
    
    Const cTempLogFileName As String = "Log.txt"
    Const cBatchFileName As String = "FTPBatch.bat"
    
    ' Make these into parameters later 'RSRS
    Dim strFTPPath As String
    Const strFTPCommand As String = "psftp.exe"
    Const strFTPScriptPrefix As String = "-b"
    Const strFTPScriptSuffix As String = ""
    
    strFTPPath = Sheets("Sheet1").Range("FTPToolPath").Value
    Set fso = New FileSystemObject
    If fso.FolderExists(strFTPPath) Then
        strTempFolderPath = LocalClaimPath ' 'Environ("Temp")
        
        If strTempFolderPath = vbNullString Then
            strTempFolderPath = "C:"
        End If
        strTempFolderPath = strTempFolderPath & "\"
        
        strTransferredFileAndPath = strTempFolderPath & LocalClaimFileName 'Me.txtLocalClaimPath.Value & Me.txtLocalClaimFileName.Value
        
        If FileType = FTPDirection.FTPPut Then
            CreateFTPOutputFile strTempFolderPath & FTPBatchFileName, strTempFolderPath, LocalClaimFileName, RemotePath, RemoteClaimFileName
            strFTPMessage = "sent: " & strTransferredFileAndPath
            bContinueProcessing = True
        Else 'FileType = FTPDirection.FTPGet
            bContinueProcessing = CreateFTPInputFile(strTempFolderPath & FTPBatchFileName, strTempFolderPath, RemotePath, RemoteProductionFileName, RemoteTestFileName)
            'strFTPMessage = "request completed for " & Me.txtProductionTraceFileName.Value & " and " & Me.txtTestTraceFileName.Value
            strFTPMessage = "request completed for " & RemoteProductionFileName
            If RemoteProductionFileName <> RemoteTestFileName Then
                strFTPMessage = strFTPMessage & " and " & RemoteTestFileName
            End If
        End If
        
        If bContinueProcessing Then
            'If Me.chkKeepWindowOpen.Value Then
            '    strWindowOpenStatus = "/k" ' not needed since the command file will open
            'Else
                strWindowOpenStatus = "/c"
            'End If
            
            iFileNumber = FreeFile()
            Open strTempFolderPath & cBatchFileName For Output As #iFileNumber
            Print #iFileNumber, "cd " & vbQuote & strFTPPath & vbQuote
            If Mid$(strFTPPath, 2, 1) = ":" Then
                ' switch to proper drive
                Print #iFileNumber, Left$(strFTPPath, 2)
            End If
            Print #iFileNumber, strFTPCommand & " " & ServerLoginName & "@" & ServerName & " -pw " & ServerPassword & " " & strFTPScriptPrefix & " " & vbQuote & strTempFolderPath & FTPBatchFileName & vbQuote & strFTPScriptSuffix
            Close #iFileNumber
            
            strFullFTPCommandLine = "cmd " & strWindowOpenStatus & " " & vbQuote & strTempFolderPath & cBatchFileName & vbQuote & "> " & strTempFolderPath & cTempLogFileName
            dblWindowID = Shell(strFullFTPCommandLine) ', vbMinimizedFocus)
            
        End If
    Else
        MsgBox "Path not found for FTP tool: " & strFTPPath
    End If
    
RunFTPBatchFile_Exit:
    Set fso = Nothing
    RunFTPBatchFile = bRunFTPBatchFile
    Exit Function
    
RunFTPBatchFile_Err:
    MsgBox Err.Description
    Resume RunFTPBatchFile_Exit
End Function

Select allOpen in new window

Then in a place like a new form code, something like this...

Sub testFTP()
    RunFTPBatchFile "c:\abc.bat", FTPDirection.FTPPut
End Sub

--
A few things:
1) I extracted this from some of my sheets, so it may need some tweaking to get it to work just right
2) This code was designed to transfer to/from a Unix box, so it may need some other changes to work on your system
3) You will need to locate and download an FTP program (you may be able to use the one that comes with Windows, but it is very limited.  I used psFTP.exe, which you can find with an Internet search
4) I defined server Named Cell so that VB can pull the information form Excel rather than being embedded into the VB code.  You may want to put these into a new sheet then hide the sheet after you get everything working.

I'll continue to work with the pieces to make sure it's all going as it's supposed to then post an updated version if I find problems.

Shahzadt: You can download the MSINET.ocx and register it and then the code will run just fine. Do not download the exe. I  believe you don't need that.

The code that I gave is very simple and it works just fine :)

Sid

The MsInet.ocx is wrapped around the WinInet API's... One thing that's not clear is wheter your using VBS(script) or Office ... If your using Office then you can use the following example http:Q_26291032.html

rspahitz: Once i copy the code into a module do i need to create a batch file before running RunFTPBatchFile; as the code is complex can you give some explanation so i could better understand what the code is doing. My apologies i am fairly new to VBA.

Yes, I need to simplify it.

the basic idea is that you push the button and it will create the batch file on the fly.  However, it needs to know a few things, like, what is the file name, do you want to push it to a server or pull it, where can it find the server (name) and how does it get into it (user name and password) then where on the server do you want to put/get the file and what name do you want to give it (if not the original).  I currently pull that info from Named cells in Excel, but it could be hard-coded too or even prompted to the user.  I also had a timing mechanism in the code to determine when the transfer is done, but I haven't found the right reference to use for Win7 64-bit edition.

I didn't have time over the weekend but I'll try to get it posted here by today, with a few variations on how to get the info to the main routine(s).

I know my post 35003029 answers the title question; the body seems to ask something different and we really need response back for a clarification.

But since people searching the DB will be enticed by the title, I think my answer will help with that.

This question has been classified as abandoned and is being closed as part of the Cleanup Program. See my comment at the end of the question for more details.