This is how much scripting it takes to upload FTP files. You're
probably better off using a pre-built FTP client with command-lines.
My script below only stores username/password in a text file on the
desktop until the files are uploaded, then anything with a password in
it is deleted (permanently deleted) for privacy.
Try it out, see what you think (watch for wordwrap)
' ###################
' Start Script
' ###################
Option Explicit
Dim objShell, objShellApp, objNetwork, objFSO, objWMIService,
objRegistry
Dim strComputer, pswdFile, ftpTextFile, userDesktop, fullTextFilePath
Dim fullPswdFilePath, ftpCommand, strPassword, strUserId
Dim folderToUpload, ftpSite, ftpDir, fileTypesToUpload
strComputer="."
Set objShell = CreateObject("WScript.Shell")
Set objShellApp = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
' No need to change this section
' ~~~~~~~~~~~~~~~~~~
pswdFile = "password.htm"
ftpTextFile = "ftpCommands.txt"
userDesktop = cStrDesktopPath
fullTextFilePath = buildMyFilePath(userDesktop,ftpTextFile)
fullPswdFilePath = buildMyFilePath(userDesktop,pswdFile)
ftpCommand = "ftp -i -s:"
' ~~~~~~~~~~~~~~~~~~
' Change this section to suit your own needs
' ~~~~~~~~~~~~~~~~~~
ftpSite = "ftp-www.earthlink.net"
ftpDir = "Flash"
fileTypesToUpload = "*.txt"
' ~~~~~~~~~~~~~~~~~~
folderToUpload = browseForFolder
createPswdFile(fullPswdFilePath)
runPswdHtml(fullPswdFilePath)
createFTPCommandsFile fullTextFilePath,ftpSite,strUserId,strPassword, _
ftpDir,folderToUpload, fileTypesToUpload
If (checkFileExists(fullTextFilePath)) Then
shellRun ftpCommand,fullTextFilePath
MsgBox "FTP Finished" & vbCr & vbCr _
& "Please confirm your files uploaded", 0, "Done"
deleteFiles(fullTextFilePath)
deleteFiles(fullPswdFilePath)
If Not (checkFileExists(fullTextFilePath)) _
And Not (checkFileExists(fullPswdFilePath)) Then
MsgBox "The above files have been deleted" _
& " for your privacy", _
0, quoteMe(pswdFile) & " & " & quoteMe(ftpTextFile)
End If
quitscript
Else
quitscript
End If
'******************************************************************************
Function shellRun(command,path)
Dim prompt
prompt = MsgBox(command & Chr(34) & path & Chr(34), 1, _
"Continue with command below?")
If prompt = 1 Then
objShell.Run command & Chr(34) & path & Chr(34), 1, True
Else
quitscript
End If
End Function
'*******************************************************************|
'******************************************************************************
Function cStrDesktopPath
cStrDesktopPath = CStr(LCase(objShell.SpecialFolders("Desktop")))
End Function
'*******************************************************************|
'******************************************************************************
Function quoteMe(x)
quoteMe = Chr(34) & x & Chr(34)
End Function
'*******************************************************************|
'******************************************************************************
Function browseForFolder
Dim objFolder, objFolder2
Dim ssfWINDOWS, ssfDRIVES, ssfPROFILE, ssfDESKTOP,
ssfDESKTOPDIRECTORY
Dim ssfPERSONAL
ssfWINDOWS = 36
ssfDRIVES = 17
ssfPROFILE = 40
ssfDESKTOP = 0
ssfDESKTOPDIRECTORY = 16
ssfPERSONAL = 5
Set objFolder = objShellApp.BrowseForFolder(0, _
"Choose Your Upload Folder", 0, ssfDESKTOP)
If (Not objFolder Is Nothing) Then
Set objFolder2 = objShellApp.NameSpace(objFolder)
If (Not objFolder2 Is Nothing) Then
Dim objFolderItem
Set objFolderItem = objFolder2.Self
If (Not objFolderItem Is Nothing) Then
Dim szReturn
szReturn = objFolderItem.Path
browseForFolder = szReturn
End If
End If
' MsgBox browseForFolder
Else
quitscript
End If
End Function
'*******************************************************************|
'******************************************************************************
Function createPswdFile(path)
Dim myFile
Set myFile = objFSO.CreateTextFile(path, True)
myFile.WriteLine("<HTML>")
myFile.WriteLine("<HEAD>")
myFile.WriteLine("<title>password.htm</title>")
myFile.WriteLine("<SCRIPT language=""VBScript"">")
myFile.WriteLine("<!--")
myFile.WriteLine("Function Window_OnLoad()")
myFile.WriteLine("UserID.focus()")
myFile.WriteLine("End Function")
myFile.WriteLine("Sub OKButton_OnClick")
myFile.WriteLine("OkClicked.Value = 1")
myFile.WriteLine("End Sub")
myFile.WriteLine("'-->")
myFile.WriteLine("</SCRIPT>")
myFile.WriteLine("</HEAD>")
myFile.WriteLine("<BODY>")
myFile.WriteLine("Your Username: <br><INPUT TYPE=text Name =
""UserID"" size=""50"">")
myFile.WriteLine("<p>")
myFile.WriteLine("Your Password: <br><INPUT TYPE=password Name =
""PasswordBox"" size=""20"">")
myFile.WriteLine("<p>")
myFile.WriteLine("<INPUT NAME=""OKButton"" TYPE=""BUTTON"" VALUE=""
OK "">")
myFile.WriteLine("<p>")
myFile.WriteLine("<input type=""hidden"" name=""OKClicked""
size=""20"" >")
myFile.WriteLine("</BODY>")
myFile.WriteLine("</HTML>")
myFile.WriteLine("<!--" &Now& " -->")
myFile.Close
End Function
'*******************************************************************|
'******************************************************************************
Function
createFTPCommandsFile(path,site,user,pswd,rmtDir,localDir,files)
Dim myFile
Set myFile = objFSO.CreateTextFile(path, True)
myFile.WriteLine("open")
myFile.WriteLine(site)
myFile.WriteLine(user)
myFile.WriteLine(pswd)
myFile.WriteLine("binary")
myFile.WriteLine("cd " & rmtDir)
myFile.WriteLine("lcd " & Chr(34) & localDir & Chr(34))
myFile.WriteLine("mput " & files)
myFile.WriteLine("bye")
myFile.Close
End Function
'*******************************************************************|
'******************************************************************************
Function checkFileExists(path)
checkFileExists = objFSO.FileExists(path)
' If Not (checkFileExists) Then
' MsgBox "Above file does not exist", 48, path
' Else
' MsgBox "Above File Exists, Continuing...", 0, path
' End If
End Function
'*******************************************************************|
'******************************************************************************
Function buildMyFilePath(folder,file)
buildMyFilePath = objFSO.BuildPath(folder, file)
' MsgBox buildMyFilePath, 0, "Result of 'buildMyFilePath' Function"
End Function
'*******************************************************************|
'******************************************************************************
Function deleteFiles(path)
If(checkFileExists(path)) Then
objFSO.DeleteFile(path)
Else
MsgBox "Above File Does Not Exist" _
& vbCr & vbCr & "Unable to Delete Above File" , 48, path
End If
End Function
'*******************************************************************|
'******************************************************************************
Function runPswdHtml(path)
On Error Resume Next
Dim objExplorer
Set objExplorer = WScript.CreateObject _
("InternetExplorer.Application", "IE_")
objExplorer.Navigate path
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Width = 400
objExplorer.Height = 250
objExplorer.Left = 0
objExplorer.Top = 0
objExplorer.Visible = 1
Wscript.Sleep 1500
Do While (objExplorer.Document.All.OKClicked.Value = "")
errorHandler
If err.number <> 0 Then
MsgBox "Cancelled by User", 0, "Cancelled"
objExplorer.Quit
quitscript
End If
Wscript.Sleep 250
Loop
strPassword = objExplorer.Document.All.PasswordBox.Value
strUserID = objExplorer.Document.All.UserID.Value
objExplorer.Quit
End Function
'*******************************************************************|
'******************************************************************************
Function errorHandler
Dim genError
If err.Number <> 0 Then
If Err.Description = "" Then
genError = "General Error"
errorHandler = genError
End If
' MsgBox errorHandler, 0, "Error Code: " & err.number
End If
End Function
'*******************************************************************|
'******************************************************************************
Sub quitscript
MsgBox "Quitting Now"
Wscript.Quit
End Sub
'*******************************************************************|
' #################
' End Script
' #################