Wednesday, March 07, 2007

FTP Upload and FTP Download with VBScript

While googling around the other day I noticed that lots of people are searching for a way to FTP files with VBScript. After looking for a while at the solutions to do this, it was clear that no real easy, free way of FTP uploading and downloading files was currently available. There are downloadable components that would present a programable API. But these are costly, and you'd have to install them. So seeing the need I decided to whip up a couple of functions that would preform some basic uploading and downloading.

Pretty straight forward, you have to supply the credentials to connect to the machine, the IP address or DNS name for the machine and then the source and destination locations. Example of syntax:

Wscript.Echo FTPDownload("192.168.1.1", "domain\user", "password", "C:\", "\", "*")

When using the download function, if you don't specify a location it will default to the working directory of the script. If for some reason there is a problem transferring the file the functions will return the error message. If they are successful, they will return "true".

Update 11-30-2007: I just made some corrections to this per the suggestions of some emails and comments I received. I retested this script, since it's been quite some time since I've had the chance to use it, and it's working like a charm. Please continue to report any issues you might have and thank you for your feedback.

**Please note that you are obviously passing credentials in plain text in this script and it presents a potential security risk.**

Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com

  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
 
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")

  sRemotePath = Trim(sRemotePath)
  sLocalFile = Trim(sLocalFile)
 
  '----------Path Checks---------
  'Here we willcheck the path, if it contains
  'spaces then we need to add quotes to ensure
  'it parses correctly.
  If InStr(sRemotePath, " ") > 0 Then
    If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
      sRemotePath = """" & sRemotePath & """"
    End If
  End If
 
  If InStr(sLocalFile, " ") > 0 Then
    If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
      sLocalFile = """" & sLocalFile & """"
    End If
  End If

  'Check to ensure that a remote path was
  'passed. If it's blank then pass a "\"
  If Len(sRemotePath) = 0 Then
    'Please note that no premptive checking of the
    'remote path is done. If it does not exist for some
    'reason. Unexpected results may occur.
    sRemotePath = "\"
  End If
 
  'Check the local path and file to ensure
  'that either the a file that exists was
  'passed or a wildcard was passed.
  If InStr(sLocalFile, "*") Then
    If InStr(sLocalFile, " ") Then
      FTPUpload = "Error: Wildcard uploads do not work if the path contains a " & _
      "space." & vbCRLF
      FTPUpload = FTPUpload & "This is a limitation of the Microsoft FTP client."
      Exit Function
    End If
  ElseIf Len(sLocalFile) = 0 Or Not oFTPScriptFSO.FileExists(sLocalFile) Then
    'nothing to upload
    FTPUpload = "Error: File Not Found."
    Exit Function
  End If
  '--------END Path Checks---------
 
  'build input file for ftp command
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "prompt n" & vbCRLF
  sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF


  sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName

  'Write the input file for the ftp command
  'to a temporary file.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing 

  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
  " > " & sFTPResults, 0, TRUE
 
  Wscript.Sleep 1000
 
  'Check results of transfer.
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  FailIfNotExist, OpenAsDefault)
  sResults = fFTPResults.ReadAll
  fFTPResults.Close
 
  oFTPScriptFSO.DeleteFile(sFTPTempFile)
  oFTPScriptFSO.DeleteFile (sFTPResults)
 
  If InStr(sResults, "226 Transfer complete.") > 0 Then
    FTPUpload = True
  ElseIf InStr(sResults, "File not found") > 0 Then
    FTPUpload = "Error: File Not Found"
  ElseIf InStr(sResults, "cannot log in.") > 0 Then
    FTPUpload = "Error: Login Failed."
  Else
    FTPUpload = "Error: Unknown."
  End If

  Set oFTPScriptFSO = Nothing
  Set oFTPScriptShell = Nothing
End Function

Function FTPDownload(sSite, sUsername, sPassword, sLocalPath, sRemotePath, _
         sRemoteFile)
  'This script is provided under the Creative Commons license located
  'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
  'be used for commercial purposes with out the expressed written consent
  'of NateRice.com

  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
 
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")

  sRemotePath = Trim(sRemotePath)
  sLocalPath = Trim(sLocalPath)
 
  '----------Path Checks---------
  'Here we will check the remote path, if it contains
  'spaces then we need to add quotes to ensure
  'it parses correctly.
  If InStr(sRemotePath, " ") > 0 Then
    If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
      sRemotePath = """" & sRemotePath & """"
    End If
  End If
 
  'Check to ensure that a remote path was
  'passed. If it's blank then pass a "\"
  If Len(sRemotePath) = 0 Then
    'Please note that no premptive checking of the
    'remote path is done. If it does not exist for some
    'reason. Unexpected results may occur.
    sRemotePath = "\"
  End If
 
  'If the local path was blank. Pass the current
  'working direcory.
  If Len(sLocalPath) = 0 Then
    sLocalpath = oFTPScriptShell.CurrentDirectory
  End If
 
  If Not oFTPScriptFSO.FolderExists(sLocalPath) Then
    'destination not found
    FTPDownload = "Error: Local Folder Not Found."
    Exit Function
  End If
 
  sOriginalWorkingDirectory = oFTPScriptShell.CurrentDirectory
  oFTPScriptShell.CurrentDirectory = sLocalPath
  '--------END Path Checks---------
 
  'build input file for ftp command
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "prompt n" & vbCRLF
  sFTPScript = sFTPScript & "mget " & sRemoteFile & vbCRLF
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF


  sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName

  'Write the input file for the ftp command
  'to a temporary file.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing 

  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
  " > " & sFTPResults, 0, TRUE
 
  Wscript.Sleep 1000
 
  'Check results of transfer.
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
                    FailIfNotExist, OpenAsDefault)
  sResults = fFTPResults.ReadAll
  fFTPResults.Close
 
  'oFTPScriptFSO.DeleteFile(sFTPTempFile)
  'oFTPScriptFSO.DeleteFile (sFTPResults)
 
  If InStr(sResults, "226 Transfer complete.") > 0 Then
    FTPDownload = True
  ElseIf InStr(sResults, "File not found") > 0 Then
    FTPDownload = "Error: File Not Found"
  ElseIf InStr(sResults, "cannot log in.") > 0 Then
    FTPDownload = "Error: Login Failed."
  Else
    FTPDownload = "Error: Unknown."
  End If
 
  Set oFTPScriptFSO = Nothing
  Set oFTPScriptShell = Nothing
End Function

Posted by Nathan Rice at 10:20:56 AM in Computers (45) | Views: 18705 | Comments (16)

Send this to:                          

Comments

Pavel said...

Its cool code! Thanks

11/20/2007 12:16:29 AM

Bryan Gilsenan said...

Hi there,

This gives me an error saying...Object required Wscript..I tried commemting out the piece which refers to Wscript but it doesn't work, any thoughts? Thanks.

11/30/2007 6:06:36 AM

Jan+Batka said...

Hi,

Just in case you would like to Up\Down-load a list of files: sep. by ";".



Dim sFileArr, i

If InStr(sRemoteFile, ";") Then
sFTPScript = sFTPScript & "USER " & sUsername & vbCrLf
sFTPScript = sFTPScript & sPassword & vbCrLf
sFTPScript = sFTPScript & "cd " & sRemotePath & vbCrLf
sFTPScript = sFTPScript & "binary" & vbCrLf
sFTPScript = sFTPScript & "prompt n" & vbCrLf
sFileArr = Split(sRemoteFile, ";")
For i = 0 To UBound(sFileArr)
sFTPScript = sFTPScript & "mget " & Trim(sFileArr(i)) & vbCrLf
Next
sFTPScript = sFTPScript & "quit" & vbCrLf & "quit" & vbCrLf & "quit" & vbCrLf
Else
sFTPScript = sFTPScript & "USER " & sUsername & vbCrLf
sFTPScript = sFTPScript & sPassword & vbCrLf
sFTPScript = sFTPScript & "cd " & sRemotePath & vbCrLf
sFTPScript = sFTPScript & "binary" & vbCrLf
sFTPScript = sFTPScript & "prompt n" & vbCrLf
sFTPScript = sFTPScript & "mget " & sRemoteFile & vbCrLf
sFTPScript = sFTPScript & "quit" & vbCrLf & "quit" & vbCrLf & "quit" & vbCrLf
End If

12/6/2007 7:32:59 AM

Guru said...

Great work Kudos... Functions are just Charm to work with.. Salutations...

3/18/2008 1:15:10 AM

candyman said...

hi, i'm learning vbs...and i'm trying to understant...sometime works, sometimes don't.
i don't figure out where to modify with my ftp, user and pass...i know it's lame...but i need help.

4/20/2008 3:19:07 PM

said...

A good code ! I like it !
Can you show me the code about Upload a file by a dll ?

6/10/2008 1:03:43 AM

said...

Very good. Works as expected and is very nicely coded.

7/1/2008 4:21:14 AM

said...

This article helped me solve a crisis. Here is the code that I wrote. A service rep enters their 4-digit employee ID number to download all the files from the FTP server that have their ID number as the first four digits of the file name.

-------------------

strUserIn = InputBox("Enter LSR ID Below","LSR File Download Utility")

if len(strUserIn) = 4 then
strUserIn = strUserIn & "*"
else
msgbox "Please enter a valid LSR ID number!",0,"LSR File Download Utility"
wscript.quit
end if

Set fs = CreateObject("Scripting.FileSystemObject")
strFileName = fs.BuildPath(Wscript.ScriptFullName & "\..", "get_lsr_files.txt")
strFileName = fs.GetAbsolutePathName(strFileName)

text_string = "open ftp.molottery.com" & chr(13) & chr(10) _
& "anonymous" & chr(13) & chr(10) _
& "password" & chr(13) & chr(10) _
& "cd IntraRpt/Sales/LSR" & chr(13) & chr(10) _
& "prompt" & chr(13) & chr(10) _
& "mget " & strUserIn & chr(13) & chr(10) _
& "quit"

Set ts = fs.OpenTextFile(strFileName, 2, True)
ts.WriteLine text_string

strFileName = fs.BuildPath(Wscript.ScriptFullName & "\..", "cl.bat")
strFileName = fs.GetAbsolutePathName(strFileName)

text_string = "set wd=%cd%" & chr(13) & chr(10) _
& "cd=""%userprofile%""\desktop\Reports" & chr(13) & chr(10) _
& """%systemroot%""\system32\ftp.exe -s:""%wd%""\get_lsr_files.txt" & chr(13) & chr(10) _
& "cd ""%wd%""" & chr(13) & chr(10) _
& "del get_lsr_files.txt" & chr(13) & chr(10) _
& "del cl.bat"

Set ts = fs.OpenTextFile(strFileName, 2, True)
ts.WriteLine text_string
ts.Close

Set objShell = CreateObject("WScript.Shell")
objShell.Run "cl.bat", , True

7/11/2008 10:33:01 AM

said...

Great, I''ve been tearing my hair out over .bat files for the last six hours. This worked first go.

8/15/2008 3:07:53 AM

said...

How do you call the FTPUpload function from a batch file or command prompt? I have tried several ways with the parameters and have been unsuccessful...

9/4/2008 2:31:49 PM

said...

Did not work. FTPUpload function always failed with ''invalid parameter'' error even though it was being passed 4 strings.

10/24/2008 4:09:29 PM

said...

Hi, I used this script in a loop and it runs 26 times works very well thanks.

However I wondered what I need to do to a message popping up after the script runs as I would like to sheduale it and leave it.

thanks
David.

11/20/2008 7:06:08 AM

said...

Hey David,

Run the script with cscript.exe instead of wscript.exe.

-Nate

11/24/2008 12:16:20 AM

said...

Nate, the "226 Transfer complete" string is not consistent across all ftp servers. Testing for presence of "226" should suffice.

-Vince

12/11/2008 5:14:44 PM

said...

I''ve tried to use FTPUpload function but always error message is unknown. I''ve tried to pass the parameters as follows:
FTPUpload("MyIP", "ftp.company.com\MyUserID", "Mypassword", "LocalPath", "ftp.company.com\Myfolder").

Where I make a mistake?

12/12/2008 9:21:04 AM

said...

Need something like this that can check on the FTP host in an unknown directory/folder name and then download the entire folder if and only if a specific file "eot.txt" is present in that folder. If not, leave the folder there.

Please advise.

12/12/2008 10:32:20 AM

Name
URL
Email
Email address is not published
Remember Me
Comments

CAPTCHA
Write the characters in the image above