通过sFTP＆FTP上传VBA，logging输出以检测错误

我写了下面的代码尝试上传到两个不同的服务器，一个通过FTP和一个通过SFTP。

我想知道是否有一个更好的方式来通过SFTP上传，因为我有它的当前方法不会触发FTP错误，如果它失败的任何部分。

我想一个解决办法，我想有的是他们两个将输出logging到一个文本文件，然后从那里我可以看到什么是手动错误，如果我想设置一个简单的读取日志，检查错误，如果x做y …

On Error GoTo Err_FTPFile ' UPLOAD FIRST FILE VIA FTP 'Build up the necessary parameters sHost = "ftp.server.com" sUser = "[e-mail]" sPass = "password" sSrc = """" + Environ("TEMP") + "\" + file + ".txt" + """" sDest = "/remote/folder/" 'Write the FTP commands to a file iFNum = FreeFile sFTPCmds1 = Environ("TEMP") & "\" & "FTPCmd1.tmp" Open sFTPCmds1 For Output As #iFNum Print #iFNum, "ftp" Print #iFNum, "open " & sHost Print #iFNum, sUser Print #iFNum, sPass Print #iFNum, "cd " & sDest Print #iFNum, "put " & sSrc Print #iFNum, "disconnect" Print #iFNum, "bye" Close #iFNum 'Upload the file Shell Environ("WINDIR") & "\System32\ftp.exe -s:" & sFTPCmds1 Application.Wait (Now + TimeValue("0:00:10")) ' UPLOAD SECOND FILE VIA SFTP 'Build up the necessary parameters sFTPDetails = "C:\psftp.exe -b C:\commands.tmp [e-mail] -pw password" sSrc = """" + Environ("TEMP") + "\" + file + ".txt" + """" sDest = "/remote/folder/" 'Write the FTP commands to a file iFNum = FreeFile sFTPCmds2 = sFolder & "\" & "commands.tmp" Open sFTPCmds2 For Output As #iFNum Print #iFNum, "cd " & sDest Print #iFNum, "put " & sSrc Print #iFNum, "quit" Print #iFNum, "bye" Close #iFNum 'Upload the file Call Shell(sFTPDetails, vbNormalFocus) Application.Wait (Now + TimeValue("0:00:10")) Exit_FTPFile: On Error Resume Next Close #iFNum 'Delete the temp FTP command file Kill sFTPCmds1 Kill sFTPCmds2 Kill Environ("TEMP") + file + ".txt" GoTo ContinuePoint Err_FTPFile: Shell "C:\FailPushBullet.exe" MsgBox Err.Number & " - " & Err.Description & " Failed.", vbOKOnly, "Error" GoTo ContinuePoint ContinuePoint: ' Do stuff 

我理想的情况是希望底层的SFTP能够像上面的FTP一样工作和运行。

我试了下面这个运行：

  sClient = "C:\psftp.exe" sArgs = "[e-mail] -pw passexample -b C:\commands.tmp" sFull = sClient & " " & sArgs sSrc = """" + Environ("TEMP") + "\" + "test" + ".txt" + """" sDest = "folder" 'Write the FTP commands to a text file iFNum = FreeFile sFTPCmds = "C:\" & "commands.tmp" Open sFTPCmds For Output As #iFNum Print #iFNum, "cd " & sDest Print #iFNum, "put " & sSrc Print #iFNum, "quit" Print #iFNum, "bye" Close #iFNum 'Upload the file Call Shell(sFull, vbNormalFocus) 

但是，如果我将sArgs更改为sArgs = "[e-mail] -pw passexample -b C:\commands.tmp 1> log.txt"它不运行，它只是closures而不做任何事情。 我认为1> log.txt应该把输出到一个文件

Answer 1

好吧，经过一些试验和错误终于find了问题，假设所有给定的参数值是有效的问题是：

1. 在username之前缺less-l选项（ line 34 ）
2. 缺lesshostname （ line 34 ）
3. sFolder未设置或为空string（ line 40 ） – 可能导致问题 – 找不到文件

line 34代码：

  sFTPDetails = "C:\psftp.exe -b C:\commands.tmp [e-mail] -pw password" 

正确的代码应该是：

  sFTPDetails = "C:\psftp.exe -b C:\commands.tmp -l [e-mail] -pw password ftp.server.com" 

作为预防措施，您可以使用代码中前面介绍的参数/variables生成命令。 另外还有一点小小的提示，通过直接写入 Cells值来debugging代码，以便以后可以在命令提示符下进行testing

  ' UPLOAD SECOND FILE VIA SFTP 'Build up the necessary parameters sHost = "ftp.server.com" sUser = "[e-mail]" sPass = "password" sSrc = """" & Environ("TEMP") & "\" + file & ".txt" & """" sDest = "/remote/folder/" sFolder = "C:" sFTP = "C:\psftp.exe" sFTPCmds2 = sFolder & "\" & "commands.tmp" sFTPDetails = sFTP & " -b " & sFTPCmds2 & " -1 " & sUser & " -pw " & sPass & " " & sHost 'FOR DEBUG Sheets(1).Cells(1,1) = sFTPDetails 'Write the FTP commands to a file iFNum = FreeFile Open sFTPCmds2 For Output As #iFNum Print #iFNum, "cd " & sDest Print #iFNum, "put " & sSrc Print #iFNum, "quit" Print #iFNum, "bye" Close #iFNum 'Upload the file Call Shell(sFTPDetails, vbNormalFocus) Application.Wait (Now + TimeValue("0:00:10")) 

如果这个代码没有运行，那么可能是参数值有问题，看到你可以在Sheet1!A1复制粘贴值并从命令提示符手动运行它。不要忘记在debugging之前注释掉line 58 ，文件不需要删除

Answer 2

使用腻子是否是一个要求？ 我推荐WinSCP在VBA中进行FTP操作。 实际上有一个.NET程序集/ COM库可以用VBA轻松实现自动化（甚至比下面的例子还要简单）。 也就是说，我的公司环境禁止用户安装.NET / COM（出于很好的理由），所以我写了自己的代码，下面简化了。

要使用下面的内容，请从以上链接下载可移植可执行文件，因为您需要使用WinSCP.com进行脚本编写。

这个例子有以下特点：

• 对于FTP和SFTP传输使用相同的协议（WinSCP）
• 写一个浓缩的，机器可读的XML日志以及全文本日志到文件
• 使用batch file而不是直接执行Shell（）; 这允许您暂停代码（或注释掉最后的Kill语句）来查看原始命令和batch file，以便于debugging。
• 从尝试parsingXML日志中显示用户友好的错误消息; 保留XML和txt日志（没有密码数据）供以后检查。

Sub上传FTP和SFTP数据：

 Public Sub FTPUpload() 'Execute the upload commands 'Create the commands file Dim ObjFSO As Object Dim ObjFile As Object Dim ObjShell As Object Dim ErrorCode As Integer Dim sTempDir As String Dim sType As String Dim sUser As String Dim sPass As String Dim sServer As String Dim sHostKey As String Dim file As String 'Using your variable name here. Dim sLocal As String Dim sRemote As String Dim sWinSCP As String '''''''''''''''''''''''''''''''''''''''''''' 'Set FTP Options '''''''''''''''''''''''''''''''''''''''''''' sTempDir = Environ("TEMP") & "\" 'Log/batch files will be stored here. sType = "ftp://" 'Or use "sftp://" sUser = "user" sPass = "password" file = "example.txt" 'Assuming you will set this earlier in your code sServer = "ftp.server.com" sLocal = Chr(34) & Environ("TEMP") & "\" & file & Chr(34) 'Note that I included the full filename in the file variable; change this as necessary. sRemote = "/remote/folder" sWinSCP = "C:\Path\To\WinSCP\WinSCP.com" ''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''' 'Create batch file and command script ''''''''''''''''''''''''''''''''''''''''''''' On Error Resume Next 'Delete existing files Kill sTempDir & "winscp.txt" Kill sTempDir & "winscp.bat" Kill sTempDir & "winscplog.xml" Kill sTempDir & "winscplog.txt" On Error GoTo 0 Set ObjFSO = CreateObject("Scripting.FileSystemObject") Set ObjFile = ObjFSO.CreateTextFile(sTempDir & "winscp.txt", True) ObjFile.writeline "open " & sType & sUser & ":" & sPass & "@" & sServer & "/" & IIf(sHostKey <> vbNullString, " -hostkey=" & Chr(34) & sHostKey & Chr(34), vbNullString) ObjFile.writeline "put " & sLocal & " " & sRemote ObjFile.writeline "close" ObjFile.writeline "exit" ObjFile.Close Set ObjFile = Nothing Set ObjFile = ObjFSO.CreateTextFile(sTempDir & "\winscp.bat", True) ObjFile.writeline sWinSCP & " /script=" & sTempDir & "winscp.txt /xmllog=" & sTempDir & "winscplog.xml /log=" & sTempDir & "winscplog.txt" ObjFile.Close Set ObjFile = Nothing Set ObjFSO = Nothing ''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''' 'Execute batch file and process output log ''''''''''''''''''''''''''''''''''''''''''''' Set ObjShell = VBA.CreateObject("WScript.Shell") ErrorCode = ObjShell.Run(sTempDir & "\winscp.bat", 0, True) Set ObjShell = Nothing If CheckOutput(sTempDir) <> "All FTP operations completed successfully." Then MsgBox CheckOutput(sTempDir) ElseIf ErrorCode > 0 Then MsgBox "Excel encountered an error when attempting to run the FTP program. Error code: " & ErrorCode Else MsgBox "All FTP operations completed successfully." End If ''''''''''''''''''''''''''''''''''''''''''''' 'Done with the FTP transfer. If you want to SFTP transfer immediately thereafter, use the below code '''''''''''''''''''''''''''''''''''''''''''' 'Re-set FTP Options '''''''''''''''''''''''''''''''''''''''''''' sType = "sftp://" 'sHostKey = "ssh-rsa 1024 9d:d9:e9:69:db:cf:9c:71:8d:cb:da:a5:cf:a7:41:a7" 'Set this if you have a hostkey that should be auto-accepted 'I assume all other options are the same, but you can change user, password, server, etc. here as well. 'Note that all code from here down is exactly the same as above; only the options have changed. '''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''' 'Create batch file and command script ''''''''''''''''''''''''''''''''''''''''''''' On Error Resume Next 'Delete existing files Kill sTempDir & "winscp.txt" Kill sTempDir & "winscp.bat" Kill sTempDir & "winscplog.xml" Kill sTempDir & "winscplog.txt" On Error GoTo 0 Set ObjFSO = CreateObject("Scripting.FileSystemObject") Set ObjFile = ObjFSO.CreateTextFile(sTempDir & "winscp.txt", True) ObjFile.writeline "open " & sType & sUser & ":" & sPass & "@" & sServer & "/" & IIf(sHostKey <> vbNullString, " -hostkey=" & Chr(34) & sHostKey & Chr(34), vbNullString) ObjFile.writeline "put " & sLocal & " " & sRemote ObjFile.writeline "close" ObjFile.writeline "exit" ObjFile.Close Set ObjFile = Nothing Set ObjFile = ObjFSO.CreateTextFile(sTempDir & "\winscp.bat", True) ObjFile.writeline sWinSCP & " /script=" & sTempDir & "winscp.txt /xmllog=" & sTempDir & "winscplog.xml /log=" & sTempDir & "winscplog.txt" ObjFile.Close Set ObjFile = Nothing Set ObjFSO = Nothing ''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''' 'Execute batch file and process output log ''''''''''''''''''''''''''''''''''''''''''''' Set ObjShell = VBA.CreateObject("WScript.Shell") ErrorCode = ObjShell.Run(sTempDir & "\winscp.bat", 0, True) Set ObjShell = Nothing If CheckOutput(sTempDir) <> "All FTP operations completed successfully." Then MsgBox CheckOutput(sTempDir) ElseIf ErrorCode > 0 Then MsgBox "Excel encountered an error when attempting to run the FTP program. Error code: " & ErrorCode Else MsgBox "All FTP operations completed successfully." End If ''''''''''''''''''''''''''''''''''''''''''''' Exit_Upload: On Error Resume Next 'Clean up (leave log files) Kill sTempDir & "winscp.txt" 'Remove scripting commands (note: this file will contain the password) Kill sTempDir & "winscp.bat" 'Remove batch file 'Clear all objects Set ObjFSO = Nothing Set ObjFile = Nothing Set ObjShell = Nothing Exit Sub End Sub 

检查输出日志并返回用户信息的函数：

 Private Function CheckOutput(sLogDir As String) As String Dim ObjFSO As Object Dim ObjFile As Object Dim StrLog As String 'Open log file Set ObjFSO = CreateObject("Scripting.FileSystemObject") Set ObjFile = ObjFSO.OpenTextFile(sLogDir & "winscplog.xml") StrLog = ObjFile.readall ObjFile.Close Set ObjFile = Nothing Set ObjFSO = Nothing 'Check log file for issues If InStr(1, StrLog, "<message>Authentication failed.</message>") > 0 Then CheckOutput = "The supplied password was rejected by the server. Please try again." ElseIf InStr(1, StrLog, "<failure>") Then If InStr(1, StrLog, "<message>Can't get attributes of file") > 0 Then CheckOutput = "The requested file does not exist on the FTP server or local folder." Else CheckOutput = "One or more attempted FTP operations has failed." End If ElseIf InStr(1, StrLog, " <result success=" & Chr(34) & "false" & Chr(34)) > 0 Then CheckOutput = "One or more attempted FTP operations has failed." ElseIf InStr(1, StrLog, " <result success=" & Chr(34) & "true" & Chr(34)) = 0 Then CheckOutput = "No FTP operations were performed. This may indicate that no files matching the file mask were found." End If 'Enter success message or append log file details. If CheckOutput = vbNullString Then CheckOutput = "All FTP operations completed successfully." Else CheckOutput = CheckOutput & vbLf & vbLf & "Please see the below files for additional information. Note that passwords are not logged for security reasons." & _ vbLf & "Condensed log: " & sLogDir & "winscplog.xml" & vbLf & "Complete log: " & sLogDir & "winscplog.txt" End If Exit_CheckOutput: On Error Resume Next Set ObjFile = Nothing Set ObjFSO = Nothing Exit Function End Function 

注意：我使用的实际代码更为详细，因为它允许比上传更多的（S）FTP操作，使用FTP类来利用对象等等。 我认为这有点超出了这个答案，但是我很乐意发布，如果这将是有益的。