Upload with VBA via sFTP & FTP, log outputs to det

2019-01-20 00:41发布

站内文章 / 前端开发
50 0 0

问题:

I wrote the following code to try and upload to two different servers one via ftp and one via sftp.

I would like to know if there is a better way to upload via SFTP because the current method as I have it doesn't trigger the FTP error if it fails on any part.

I guess a work around and something I would like to have is for both of them to log the output to a text file and then from that I can see what the error was manually and if I want setup a simple read log, check error, if x do y...

        On Error GoTo Err_FTPFile

        ' UPLOAD FIRST FILE VIA FTP

        'Build up the necessary parameters
        sHost = "ftp.server.com"
        sUser = "user@server.com"
        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 user@ex.server.com -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

I ideally would like the SFTP one at the bottom to work and function exactly like the FTP one from above.

I tried the following and this runs:

    sClient = "C:\psftp.exe"
    sArgs = "user@website.com -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)

But if I change the sArgs to sArgs = "user@website.com -pw passexample -b C:\commands.tmp 1> log.txt" it doesn't run, it just closes without doing anything. I thought 1> log.txt is supposed to put the output into a file

回答1:

OK.. after some trial and error finally I found the problem, with assumption that all value in given parameters is valid the problem are:

  1. missing the -l option before username (line 34)
  2. missing the hostname (line 34)
  3. sFolder not set or empty string (line 40) - may cause a problem - file not found

Code on line 34:

 sFTPDetails = "C:\psftp.exe -b C:\commands.tmp user@ex.server.com -pw password"

The right code should be:

 sFTPDetails = "C:\psftp.exe -b C:\commands.tmp -l user@ex.server.com -pw password ftp.server.com"

As prevention may be you can generate your command using parameter/variable that described earlier in the code. Also there is a little hint to debug your code by write it directly to Cells value so later can be tested in command prompt

   ' UPLOAD SECOND FILE VIA SFTP

    'Build up the necessary parameters
    sHost = "ftp.server.com"
    sUser = "user@server.com"
    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"))

If this code not running then may be something wrong with parameter values, to see that you can just copy paste value in Sheet1!A1 and run it manually from command prompt..and don't forget to comment out line 58 before debugging so the file needed not deleted



回答2:

Is it a requirement to use Putty? I recommend WinSCP for FTP operations within VBA. There is actually a .NET assembly/COM library available for easy automation with VBA (even easier than my below example). That said, my corporate environment prohibits users from installing .NET/COM (for good reason), so I wrote my own code, simplified below.

To use the below, download the Portable executables from the above link as you will need WinSCP.com for the scripting.

This example has the following features:

  • Uses the same protocol (WinSCP) for both FTP and SFTP transfers
  • Writes a condensed, machine-readable XML log as well as a full text log to files
  • Uses batch files rather than direct Shell() executions; this allows you to pause the code (or comment out the final Kill statements) to view original command and batch files for easy debugging.
  • Displays a user-friendly error message from attempts to parse the XML log; retains the XML and txt log (with no password data) for later review.

Sub to upload the FTP and SFTP data:

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

Function to check the output log and return a message for the user:

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

Note: the actual code that I use is significantly more detailed, as it allows for more (S)FTP operations than uploading, uses an FTP class to utilize objects instead, and more. I think that goes a bit beyond a SO answer, but I am happy to post if it would be helpful.



标签： excel vba excel-vba ftp sftp
举报

收藏的人(0)

Ta的文章 更多文章
登录 后发表评论
0条评论
还没有人评论过~