Solved

Upload a file to FTP Server

Posted on 2011-02-25
13
783 Views
Last Modified: 2013-11-10
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.
0
Comment
Question by:Shahzadt
13 Comments
 
LVL 22

Expert Comment

by:rspahitz
ID: 34984729
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.
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 34984782
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

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.
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 34984855
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

Open in new window

0
 
LVL 22

Expert Comment

by:rspahitz
ID: 34984875
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.
0
 
LVL 30

Expert Comment

by:SiddharthRout
ID: 34985138
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
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 34988370
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
0
 

Author Comment

by:Shahzadt
ID: 34998721
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.
0
 
LVL 22

Expert Comment

by:rspahitz
ID: 34999658
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).
0
 
LVL 22

Accepted Solution

by:
rspahitz earned 500 total points
ID: 35003029
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
    
TransferFile_Exit:
    Close #iFileNumber
    Exit Sub
    
TransferFile_Err:
    MsgBox Err.Description
    Resume TransferFile_Exit
End Sub

Open in new window

0
 
LVL 22

Expert Comment

by:rspahitz
ID: 35191134
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.
0
 
LVL 24

Expert Comment

by:broomee9
ID: 35356942
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.
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Although it can be difficult to imagine, someday your child will have a career of his or her own. He or she will likely start a family, buy a home and start having their own children. So, while being a kid is still extremely important, it’s also …
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

759 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now