• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 890
  • Last Modified:

Upload a file to FTP Server

Hi Sid,

I am a new member to expert-change and not sure how exactly if this is allowed.  I was reading your post http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_26703240.html I see the solution that you have provided; unfortunatly I am having similar issues (dont have MSINET.ocx); i downloaded the VBC6 file but once i try to run the .exe file it throws an error... "visual basic 6.0 was not detected on this system".  i have tried the secound solution as well that you provided in the same post (http://www.bygsoftware.com/Excel/VBA/ftp.htm) this one is running the code but nothing gets uploaded to the site. can you point me in the right direction. thanks in advance.
1 Solution
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
        If strExistingFileName1 = vbNullString Then
            strFileFoundMessage = strExistingFileName2
        ElseIf strExistingFileName2 = vbNullString Then
            strFileFoundMessage = strExistingFileName1
        ElseIf strExistingFileName1 = strExistingFileName2 Then
            strFileFoundMessage = strExistingFileName1
            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 = bFileCreated
    Exit Function
    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
        'exit sub
        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 = bFileCreated
    Exit Function
    MsgBox Err.Description
    Resume CreateFTPOutputFile_Exit
End Function

Open 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
                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
        MsgBox "Path not found for FTP tool: " & strFTPPath
    End If
    Set fso = Nothing
    RunFTPBatchFile = bRunFTPBatchFile
    Exit Function
    MsgBox Err.Description
    Resume RunFTPBatchFile_Exit
End Function

Open in new window

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

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 :)

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
ShahzadtAuthor Commented:
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).
OK this should work a bit better.  However, you may need to add the FTP option to your Windows installation from the Windows CD or, in Windows 7, from the "add features" option.
also, as mentioned, you can get sFTP which offers SecureFTP options that are not available in the standard Windows version.

To run it, go to the sub called "x" and update the settings.  I added demo information for transferring out to a server and in from the same server.  Make sure the cursor is still in this sub and press F5.  A DOS window will open in the background showing the various commands that were sent and whether they were successful.  you'll also get a windows dialog box telling you to wait for that window to close.  (I added a pause so you can ensure the commands were sent correctly, but I am unable to test them at this point since I'm running in a secure environment that doesn't support this FTP.)

Option Explicit

Public Enum PushOrPullConstants
    PushIt = 1
    PullIt = 2
End Enum

Private Sub x()
    TransferFile "anything.txt", "C:\", "/usr/dir2", "comp.domain.com", "itsme", "imh3r3", PushIt
    TransferFile "anything.txt", "C:\", "/usr/dir2", "comp.domain.com", "itsme", "imh3r3", PullIt
End Sub

Private Sub TransferFile( _
    FileName As String, _
    LocalPath As String, _
    RemotePath As String, _
    ServerName As String, _
    UserName As String, _
    Password As String, _
    PushOrPull As PushOrPullConstants)

    On Error GoTo TransferFile_Err
    Dim iFileNumber As Integer
    Dim strBatchFileName As String
    Dim strBatchFilePath As String
    Dim strFTPCommand As String
    Dim strFTPCommandFileName As String
    Dim strFTPCommandPath As String
    Dim strFTPCommandFile As String
    strBatchFileName = "FTPit.bat" ' pick a name ending in .bat
    strBatchFilePath = Environ("Temp") & "\" & strBatchFileName
    strFTPCommandFileName = "ftpcmds.fil" ' pick a name you like
    strFTPCommandPath = Environ("Temp") & "\" & strFTPCommandFileName
    ' define a batch file to transfer data between server to local machine
    strFTPCommand = "FTP -s:" & strFTPCommandFileName
    strFTPCommandFile = "open " & ServerName & vbNewLine
    strFTPCommandFile = strFTPCommandFile & "user " & UserName & " " & Password & vbNewLine
    strFTPCommandFile = strFTPCommandFile & "cd " & RemotePath & vbNewLine
    strFTPCommandFile = strFTPCommandFile & "lcd " & LocalPath & vbNewLine
    If PushOrPull = PushOrPullConstants.PullIt Then
        ' create ftp command file to pull data to remote machine
        strFTPCommandFile = strFTPCommandFile & "get " & FileName & vbNewLine
    Else 'PushOrPullConstants.PushIt
        ' create ftp command file to push data to remote machine
        strFTPCommandFile = strFTPCommandFile & "put " & FileName & vbNewLine
    End If
    strFTPCommandFile = strFTPCommandFile & "close" & vbNewLine
    strFTPCommandFile = strFTPCommandFile & "quit" & vbNewLine
    ' remove old FTP command file if it exists
    If Dir(strFTPCommandPath) <> "" Then
        Kill strFTPCommandPath
    End If
    ' create FTP command file
    iFileNumber = FreeFile()
    Open strFTPCommandPath For Output As #iFileNumber
    Print #iFileNumber, strFTPCommandFile
    Close #iFileNumber
    ' remove old batch file if it exists
    If Dir(strBatchFilePath) <> "" Then
        Kill strBatchFilePath
    End If
    ' create batch file to run FTP commands
    iFileNumber = FreeFile()
    Open strBatchFilePath For Output As #iFileNumber
    Print #iFileNumber, strFTPCommand
    Print #iFileNumber, "pause" ' take this out when it works as expected
    Close #iFileNumber
    Shell "cmd /c " & strBatchFilePath
    MsgBox "When the DOS window closes, the file transfer completed.", vbOKOnly Or vbInformation
    Close #iFileNumber
    Exit Sub
    MsgBox Err.Description
    Resume TransferFile_Exit
End Sub

Open in new window

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.
TracyVBA DeveloperCommented:
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.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now