1. 首页
  2. 问答
  3. 通过sFTP＆FTP上传VBA，通过日志输出检测错误

通过sFTP＆FTP上传VBA，通过日志输出检测错误

2016-02-17 59 views
4

我编写了下面的代码，试图通过ftp和一个通过sftp上传到两个不同的服务器。通过sFTP＆FTP上传VBA，通过日志输出检测错误

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

我想一个解决办法，我想要的是他们两个将输出记录到文本文件，然后从中我可以看到错误是手动的，如果我想设置一个简单的读取日志，检查错误，如果x做Y ...

 On Error GoTo Err_FTPFile 

     ' UPLOAD FIRST FILE VIA FTP 

     'Build up the necessary parameters 
     sHost = "ftp.server.com" 
     sUser = "[email protected]" 
     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 [email protected] -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 = "[email protected] -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)

但是，如果我改变对个SARG它sArgs = "[email protected] -pw passexample -b C:\commands.tmp 1> log.txt"不运行，它只是关闭没有做任何事情。我以为1> log.txt应该将输出到文件

来源

2016-02-17 Ryflex

+0

与您的问题没有直接关系，但您应该使用'Resume'来退出错误处理块，而不是'GoTo'。像这样使用'GoTo'意味着你不能在该点之后使用任何错误处理。 – Kyle

+0

@Kyle我可以在下一个goto下使用它吗？ – Ryflex

+0

@Kyle是正确的 - 通过在这里使用GoTo，你不能在子程序中进行任何进一步的错误处理，因为Excel认为从该点开始的所有代码都是初始错误处理的一部分。清楚的是，这意味着如果在“ContinuePoint”引用之后遇到另一个错误，Excel将无法正确处理它。如果将行更改为“Resume ContinuePoint”，那么您将有适当的错误处理。有关错误处理的更多信息，请参阅http://www.cpearson.com/excel/errorhandling.htm（请注意“简历声明”部分）。 –

回答

1

行..一些试验和错误后，终于让我找到了问题，有假设，即给定参数的所有值有效的问题是：

  1. 失踪前username（line 34）
  2. 的-l选项缺少hostname（line 34）
  3. sFolder没有设置或者为空（line 40） - 可能会导致一个问题 - 文件不发现

守则line 34：

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

正确的代码应该是：

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

预防可能是你可以使用的代码前面所述的参数/变量产生你的命令。也有一个小提示调试代码由写直接把它Cells值，以便以后可以在命令提示符下

' UPLOAD SECOND FILE VIA SFTP 

    'Build up the necessary parameters 
    sHost = "ftp.server.com" 
    sUser = "[email protected]" 
    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并从命令提示符手动运行它。并且不要忘记在调试之前将line 58注释掉，因此文件不需要删除

来源

2016-02-22 02:09:29 Susilo

1

是否需要使用Putty？我建议WinSCP用于VBA中的FTP操作。实际上有一个.NET程序集/ COM库可以通过VBA轻松实现自动化（甚至比下面的示例还要容易）。也就是说，我的企业环境禁止用户安装.NET/COM（出于很好的理由），所以我编写了自己的代码，下面简化了它。

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

该示例具有以下功能：

  • 使用相同的协议（WinSCP赋予），用于FTP和SFTP传输
  • 写入一个冷凝，机器可读的XML日志以及全文 日志到文件
  • 使用批处理文件而不是直接执行Shell（）执行;这允许您将 暂停代码（或注释掉最终的Kill语句）至 查看原始命令和批处理文件以便于调试。
  • 显示用户友好的错误消息，试图解析XML 日志;保留XML和txt日志（无密码数据）以供日后 审核。

子上传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类来利用对象等等。我认为这超出了SO的答案，但我很高兴发布，如果它会有所帮助。

来源

2016-02-26 05:39:12

相关问题

 相关问题