VBA et FTP

Ce mémo a été publié le 5 octobre 2010 et peut contenir des informations qui peuvent être incomplètes, non mises à jour voir erronées du fait de son ancienneté. N'hésitez pas à compléter votre recherche sur des articles plus récents.

Rate this post

Comment envoyer ou télécharger des fichiers sur un serveur FTP en VBA.
Testé avec succès dans Access 2003.

Source : http://www.naterice.com/articles/51

Comme le dit l’auteur, attention, le mot de passe FTP est en clair, ce qui peut poser des problèmes de sécurité.

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209

<span style="vertical-align: top;"><span style="color: #000080;">Function</span> FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath)</span> <span style="vertical-align: top;">  <span style="color: #008000;">'This script is provided under the Creative Commons license located</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'be used for commercial purposes with out the expressed written consent</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'of NateRice.com</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #000080;">Const</span> OpenAsDefault = -2</span> <span style="vertical-align: top;">  <span style="color: #000080;">Const</span> FailIfNotExist = 0</span> <span style="vertical-align: top;">  <span style="color: #000080;">Const</span> ForReading = 1</span> <span style="vertical-align: top;">  <span style="color: #000080;">Const</span> ForWriting = 2</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")</span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> oFTPScriptShell = CreateObject("WScript.Shell")</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  sRemotePath = Trim(sRemotePath)</span> <span style="vertical-align: top;">  sLocalFile = Trim(sLocalFile)</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'----------Path Checks---------</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'Here we willcheck the path, if it contains</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'spaces then we need to add quotes to ensure</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'it parses correctly.</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">If</span> InStr(sRemotePath, " ") &gt; 0 <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    <span style="color: #000080;">If</span> Left(sRemotePath, 1) &lt;&gt; """" <span style="color: #000080;">And</span> Right(sRemotePath, 1) &lt;&gt; """" <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">      sRemotePath = """" &amp; sRemotePath &amp; """"</span> <span style="vertical-align: top;">    <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #000080;">If</span> InStr(sLocalFile, " ") &gt; 0 <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    <span style="color: #000080;">If</span> Left(sLocalFile, 1) &lt;&gt; """" <span style="color: #000080;">And</span> Right(sLocalFile, 1) &lt;&gt; """" <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">      sLocalFile = """" &amp; sLocalFile &amp; """"</span> <span style="vertical-align: top;">    <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'Check to ensure that a remote path was</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'passed. If it's blank then pass a ""</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">If</span> Len(sRemotePath) = 0 <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    <span style="color: #008000;">'Please note that no premptive checking of the</span></span> <span style="vertical-align: top;">    <span style="color: #008000;">'remote path is done. If it does not exist for some</span></span> <span style="vertical-align: top;">    <span style="color: #008000;">'reason. Unexpected results may occur.</span></span> <span style="vertical-align: top;">    sRemotePath = ""</span> <span style="vertical-align: top;">  <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'Check the local path and file to ensure</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'that either the a file that exists was</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'passed or a wildcard was passed.</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">If</span> InStr(sLocalFile, "*") <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    <span style="color: #000080;">If</span> InStr(sLocalFile, " ") <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">      FTPUpload = "Error: Wildcard uploads <span style="color: #000080;">do</span> <span style="color: #000080;">not</span> work <span style="color: #000080;">if</span> the path contains a " &amp; _</span> <span style="vertical-align: top;">      "space." &amp; vbCRLF</span> <span style="vertical-align: top;">      FTPUpload = FTPUpload &amp; "This <span style="color: #000080;">is</span> a limitation of the Microsoft FTP client."</span> <span style="vertical-align: top;">      <span style="color: #000080;">Exit</span> <span style="color: #000080;">Function</span></span> <span style="vertical-align: top;">    <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">ElseIf</span> Len(sLocalFile) = 0 <span style="color: #000080;">Or</span> <span style="color: #000080;">Not</span> oFTPScriptFSO.FileExists(sLocalFile) <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    <span style="color: #008000;">'nothing to upload</span></span> <span style="vertical-align: top;">    FTPUpload = "Error: File <span style="color: #000080;">Not</span> Found."</span> <span style="vertical-align: top;">    <span style="color: #000080;">Exit</span> <span style="color: #000080;">Function</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'--------END Path Checks---------</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'build input file for ftp command</span></span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; "USER " &amp; sUsername &amp; vbCRLF</span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; sPassword &amp; vbCRLF</span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; "cd " &amp; sRemotePath &amp; vbCRLF</span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; "binary" &amp; vbCRLF</span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; "prompt n" &amp; vbCRLF</span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; "put " &amp; sLocalFile &amp; vbCRLF</span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; "quit" &amp; vbCRLF &amp; "quit" &amp; vbCRLF &amp; "quit" &amp; vbCRLF</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")</span> <span style="vertical-align: top;">  sFTPTempFile = sFTPTemp &amp; "" &amp; oFTPScriptFSO.GetTempName</span> <span style="vertical-align: top;">  sFTPResults = sFTPTemp &amp; "" &amp; oFTPScriptFSO.GetTempName</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'Write the input file for the ftp command</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'to a temporary file.</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, <span style="color: #000080;">True</span>)</span> <span style="vertical-align: top;">  fFTPScript.WriteLine(sFTPScript)</span> <span style="vertical-align: top;">  fFTPScript.<span style="color: #000080;">Close</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> fFTPScript = <span style="color: #000080;">Nothing</span> </span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" &amp; sFTPTempFile &amp; " " &amp; sSite &amp; _</span> <span style="vertical-align: top;">  " &gt; " &amp; sFTPResults, 0, <span style="color: #000080;">TRUE</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  Wscript.Sleep 1000</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'Check results of transfer.</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _</span> <span style="vertical-align: top;">  FailIfNotExist, OpenAsDefault)</span> <span style="vertical-align: top;">  sResults = fFTPResults.ReadAll</span> <span style="vertical-align: top;">  fFTPResults.<span style="color: #000080;">Close</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  oFTPScriptFSO.DeleteFile(sFTPTempFile)</span> <span style="vertical-align: top;">  oFTPScriptFSO.DeleteFile (sFTPResults)</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #000080;">If</span> InStr(sResults, "226 Transfer complete.") &gt; 0 <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    FTPUpload = <span style="color: #000080;">True</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">ElseIf</span> InStr(sResults, "File <span style="color: #000080;">not</span> found") &gt; 0 <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    FTPUpload = "Error: File <span style="color: #000080;">Not</span> Found"</span> <span style="vertical-align: top;">  <span style="color: #000080;">ElseIf</span> InStr(sResults, "cannot log <span style="color: #000080;">in</span>.") &gt; 0 <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    FTPUpload = "Error: Login Failed."</span> <span style="vertical-align: top;">  <span style="color: #000080;">Else</span></span> <span style="vertical-align: top;">    FTPUpload = "Error: Unknown."</span> <span style="vertical-align: top;">  <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> oFTPScriptFSO = <span style="color: #000080;">Nothing</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> oFTPScriptShell = <span style="color: #000080;">Nothing</span></span> <span style="vertical-align: top;"><span style="color: #000080;">End</span> <span style="color: #000080;">Function</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;"><span style="color: #000080;">Function</span> FTPDownload(sSite, sUsername, sPassword, sLocalPath, sRemotePath, _</span> <span style="vertical-align: top;">         sRemoteFile)</span> <span style="vertical-align: top;">  <span style="color: #008000;">'This script is provided under the Creative Commons license located</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'be used for commercial purposes with out the expressed written consent</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'of NateRice.com</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #000080;">Const</span> OpenAsDefault = -2</span> <span style="vertical-align: top;">  <span style="color: #000080;">Const</span> FailIfNotExist = 0</span> <span style="vertical-align: top;">  <span style="color: #000080;">Const</span> ForReading = 1</span> <span style="vertical-align: top;">  <span style="color: #000080;">Const</span> ForWriting = 2</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")</span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> oFTPScriptShell = CreateObject("WScript.Shell")</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  sRemotePath = Trim(sRemotePath)</span> <span style="vertical-align: top;">  sLocalPath = Trim(sLocalPath)</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'----------Path Checks---------</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'Here we will check the remote path, if it contains</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'spaces then we need to add quotes to ensure</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'it parses correctly.</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">If</span> InStr(sRemotePath, " ") &gt; 0 <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    <span style="color: #000080;">If</span> Left(sRemotePath, 1) &lt;&gt; """" <span style="color: #000080;">And</span> Right(sRemotePath, 1) &lt;&gt; """" <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">      sRemotePath = """" &amp; sRemotePath &amp; """"</span> <span style="vertical-align: top;">    <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'Check to ensure that a remote path was</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'passed. If it's blank then pass a ""</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">If</span> Len(sRemotePath) = 0 <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    <span style="color: #008000;">'Please note that no premptive checking of the</span></span> <span style="vertical-align: top;">    <span style="color: #008000;">'remote path is done. If it does not exist for some</span></span> <span style="vertical-align: top;">    <span style="color: #008000;">'reason. Unexpected results may occur.</span></span> <span style="vertical-align: top;">    sRemotePath = ""</span> <span style="vertical-align: top;">  <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'If the local path was blank. Pass the current</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'working direcory.</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">If</span> Len(sLocalPath) = 0 <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    sLocalpath = oFTPScriptShell.CurrentDirectory</span> <span style="vertical-align: top;">  <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #000080;">If</span> <span style="color: #000080;">Not</span> oFTPScriptFSO.FolderExists(sLocalPath) <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    <span style="color: #008000;">'destination not found</span></span> <span style="vertical-align: top;">    FTPDownload = "Error: Local Folder <span style="color: #000080;">Not</span> Found."</span> <span style="vertical-align: top;">    <span style="color: #000080;">Exit</span> <span style="color: #000080;">Function</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  sOriginalWorkingDirectory = oFTPScriptShell.CurrentDirectory</span> <span style="vertical-align: top;">  oFTPScriptShell.CurrentDirectory = sLocalPath</span> <span style="vertical-align: top;">  <span style="color: #008000;">'--------END Path Checks---------</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'build input file for ftp command</span></span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; "USER " &amp; sUsername &amp; vbCRLF</span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; sPassword &amp; vbCRLF</span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; "cd " &amp; sRemotePath &amp; vbCRLF</span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; "binary" &amp; vbCRLF</span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; "prompt n" &amp; vbCRLF</span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; "mget " &amp; sRemoteFile &amp; vbCRLF</span> <span style="vertical-align: top;">  sFTPScript = sFTPScript &amp; "quit" &amp; vbCRLF &amp; "quit" &amp; vbCRLF &amp; "quit" &amp; vbCRLF</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")</span> <span style="vertical-align: top;">  sFTPTempFile = sFTPTemp &amp; "" &amp; oFTPScriptFSO.GetTempName</span> <span style="vertical-align: top;">  sFTPResults = sFTPTemp &amp; "" &amp; oFTPScriptFSO.GetTempName</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'Write the input file for the ftp command</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'to a temporary file.</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, <span style="color: #000080;">True</span>)</span> <span style="vertical-align: top;">  fFTPScript.WriteLine(sFTPScript)</span> <span style="vertical-align: top;">  fFTPScript.<span style="color: #000080;">Close</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> fFTPScript = <span style="color: #000080;">Nothing</span> </span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" &amp; sFTPTempFile &amp; " " &amp; sSite &amp; _</span> <span style="vertical-align: top;">  " &gt; " &amp; sFTPResults, 0, <span style="color: #000080;">TRUE</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  Wscript.Sleep 1000</span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'Check results of transfer.</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _</span> <span style="vertical-align: top;">                    FailIfNotExist, OpenAsDefault)</span> <span style="vertical-align: top;">  sResults = fFTPResults.ReadAll</span> <span style="vertical-align: top;">  fFTPResults.<span style="color: #000080;">Close</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #008000;">'oFTPScriptFSO.DeleteFile(sFTPTempFile)</span></span> <span style="vertical-align: top;">  <span style="color: #008000;">'oFTPScriptFSO.DeleteFile (sFTPResults)</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #000080;">If</span> InStr(sResults, "226 Transfer complete.") &gt; 0 <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    FTPDownload = <span style="color: #000080;">True</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">ElseIf</span> InStr(sResults, "File <span style="color: #000080;">not</span> found") &gt; 0 <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    FTPDownload = "Error: File <span style="color: #000080;">Not</span> Found"</span> <span style="vertical-align: top;">  <span style="color: #000080;">ElseIf</span> InStr(sResults, "cannot log <span style="color: #000080;">in</span>.") &gt; 0 <span style="color: #000080;">Then</span></span> <span style="vertical-align: top;">    FTPDownload = "Error: Login Failed."</span> <span style="vertical-align: top;">  <span style="color: #000080;">Else</span></span> <span style="vertical-align: top;">    FTPDownload = "Error: Unknown."</span> <span style="vertical-align: top;">  <span style="color: #000080;">End</span> <span style="color: #000080;">If</span></span> <span style="vertical-align: top;">&nbsp;</span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> oFTPScriptFSO = <span style="color: #000080;">Nothing</span></span> <span style="vertical-align: top;">  <span style="color: #000080;">Set</span> oFTPScriptShell = <span style="color: #000080;">Nothing</span></span> <span style="vertical-align: top;"><span style="color: #000080;">End</span> <span style="color: #000080;">Function</span></span>

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

Laisser un commentaire Annuler la réponse