2

enter image description hereIf I copy the contents of the bat file and enter directly onto the command line in cmd.exe, the WinSCP SFTP script transfers the file from local directory to SFTP site. When I run it from this VBA code, I do not get any log files created. The winscp.bat and winscp.txt files are created. The ErrorCode that is returned is a "1".

Any help would be appreciated.

Public Sub SFTPUpload()
'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 sBat 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 SFTP Options
 ''''''''''''''''''''''''''''''''''''''''''''
 sTempDir = DataPath & "Log\" 'Log/batch files will be stored here.
 sType = "sftp://"
 sUser = "User"
 sPass = "Name"
 file = DataPath & FileName
 sServer = "sftp.dfsco.int"
 sHostKey = "ssh-rsa 1024 9d:d9:e9:69:db:cf:9c:71:8d:cb:da:a5:cf:a7:41:a7"
 sLocal = file
 sWinSCP = "C:\Program Files (x86)\WinSCP\WinSCP.com"
 If SFTP_USE_TEST_SITE Then
         sRemote = "/Allianz/DFS/CSR/Test/OneToMany/"
     Else
         sRemote = "/Allianz/DFS/CSR/Prod/OneToMany/"
    End If
'''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''
'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 /log=" & 
   sTempDir & "winscplog.txt /xmllog=" & sTempDir & "winscplog.xml /ini=nul 
   /loglevel=2"
ObjFile.Close
Set ObjFile = Nothing
Set ObjFSO = Nothing
'''''''''''''''''''''''''''''''''''''''''''''

'''''''''''''''''''''''''''''''''''''''''''''
'Execute batch file and process output log
'''''''''''''''''''''''''''''''''''''''''''''
 Set ObjShell = VBA.CreateObject("WScript.Shell")
 sBat = sTempDir & "winscp.bat"
 ErrorCode = ObjShell.Run(sBat, 1, True)
 Set ObjShell = Nothing
 If CheckOutput(sTempDir) <> "All FTP operations completed successfully." 
     Then  'MsgBox CheckOutput(sTempDir)
 If ErrorCode > 0 Then
       MsgBox "Excel encountered an error when attempting to run the FTP 
       program. Error code: " & ErrorCode
 Else
       MsgBox "One2Many file has been sent to ADMS."
 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

Sub UpdateStatus(ByVal StepNum As String, ByVal Desc As String)
Dim MyStr As String

MyStr = Now & ": " & StepNum & " - " & Desc
frmEDLBilling.txtStatus = frmEDLBilling.txtStatus & MyStr & vbCrLf
oWS_Log.Cells(Log_Row, 1) = MyStr
Log_Row = Log_Row + 1
DoEvents
End Sub

Output for Winscp.bat & winscp.txt is as follows:

Winscp.bat contains the following: 
"C:\Program Files (x86)\WinSCP\WinSCP.com" /script="D:Da‌​ta\Test\Log\winscp‌​.t‌​xt" /log="D:\Data\‌​‌​Test\Log\winscplog‌​.t‌​xt" /xmllog="D:\Da‌​‌​ta\Test\Log\winscp‌​lo‌​g.xml" /ini=nul                                                                                       

Winscp.txt contains the following: 
open sftp://userID:[email protected]/ - hostkey="actual hostkey" 
put D:\Data\Test\‌​‌​‌​AZL_ONE2MANY_PDF_MAS‌​TER.txt /Allianz/Test/OneToMany/           
close                                                                    
exit 
9
  • Where exactly is the error occurring? Pasting huge blocks of code without very good reason is generally frowned upon. If you need some pointers on how to decrease the amount of code you need to show please take a look at How to create a Minimal, Complete, and Verifiable example. Commented Oct 20, 2017 at 20:45
  • Would be useful to include examples of the FTP script and bat files which are produced. Are all file paths correctly quoted? It's hard to tell what's going on here: file = DataPath & FileName Commented Oct 20, 2017 at 20:58
  • Is the log file winscplog.txt created? If it is, add it to the question. Commented Oct 21, 2017 at 14:20
  • @Taelsin, Thank you for your comment. This is the first time posting. I get an error at the following statement: ErrorCode = ObjShell.Run(sBat, 1, True). ErrorCode is "1". Commented Oct 24, 2017 at 17:20
  • 1
    Please edit your question to add the outputs: they are unreadable in the comments... Commented Oct 24, 2017 at 19:16

2 Answers 2

0

You are missing double quotes around the path to winscp.com (as it contains a space in the Program Files (x86)).

I cannot imagine that the .bat file works, if you run it manually, despite your claim that it does.

The code should be:

ObjFile.writeline Chr(34) & sWinSCP & Chr(34) & " /script=" ...
Sign up to request clarification or add additional context in comments.

2 Comments

I made the changes as you suggested and received a compile error "sub or function not defined"
Where do you get that?
0

AND the answer is: the double quotes around Program files (x86), added them before and after the file paths for /script and /log AND, the last issue I had was that somehow I changed "Program Files (x86)" to "Program Files (x86}". The code is finally working. Thanks for the tips on how to ask a question and also for pointing me in the right direction on double quotes.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.