|
Hier ist der Beispiel Code
Option Explicit
Public Const cHostName = "example-group.com"
Public Const cUserName = "user_1"
Public Const cPassword = "PW_123_567&89"
Public Const cSshHostKeyFingerprint = "ssh-rsa 2000 xx:xx:xx:xx:xx:xx:xx:xx:xx:xx:xx:xx:xx:xx:xx:xx"
Public pErrorMessage As String
Public pMessage As String
' Shell variant
' WinSCP console interface .NET wrapper -> muss nach der Installation von WinSCP bei Extras/Verweise eingebunden sein
' http://winscp.net/eng/docs/library_vb
Private Sub fl_load_SFTP(ByVal strHost As String, _
ByVal strUser As String, _
ByVal strPW As String, _
ByVal strKeyFP As String, _
ByVal Transtyp As String, _
ByVal FTPOrdner As String, _
ByVal Pfad As String, _
ByVal FileName As String)
Dim mySessionOptions As New sessionOptions
Dim mySession As New Session
Dim myTransferOptions As New TransferOptions
Dim directoryInfo As RemoteDirectoryInfo
Dim transfer As TransferEventArgs
Dim transferResult As TransferOperationResult
'--------< fl_Download_SFTP() >--------
'sftp-Session
' Enable custom error handling
On Error Resume Next
'< get FileExplorer Functions >
' Setup session options
With mySessionOptions
.Protocol = Protocol_Sftp
.HostName = strHost
.UserName = strUser
.Password = strPW
.SshHostKeyFingerprint = strKeyFP
End With
'</ get FileExplorer Functions >
' Connect
mySession.Open mySessionOptions
myTransferOptions.TransferMode = TransferMode_Binary
Set directoryInfo = mySession.ListDirectory(FTPOrdner)
Select Case Transtyp
Case "Download"
Application.StatusBar = "Downlod der Datei '" & FileName & "' von dem Server '" & strHost & "' läuft!"
Set transferResult = mySession.GetFiles(FTPOrdner & FileName, Pfad, False, myTransferOptions)
' Throw on any error
transferResult.Check
For Each transfer In transferResult.Transfers
' MsgBox "Upload of " & transfer.FileName & " succeeded"
pMessage = pMessage & "<p></p> Download der Datei '" & Replace(transfer.FileName, FTPOrdner, "") & "' war erfolgreich " & "<o:p>" ' für html Textnachricht, die später an Email body angehängt wird
Next
Case "Upload" ' noch nicht getestet
' ' Upload files
Application.StatusBar = "Upload der Datei '" & FileName & "' auf den Server '" & strHost & "' läuft!"
Set transferResult = mySession.PutFiles(Pfad & FileName, FTPOrdner, False, myTransferOptions)
' Throw on any error
transferResult.Check
' Display results
For Each transfer In transferResult.Transfers
pMessage = pMessage & "<p></p> Upload der Datei '" & Replace(transfer.FileName, FTPOrdner, "") & "' war erfolgreich " & "<o:p>" ' für html Textnachricht, die später an Email body angehängt wird
Next
End Select
'--< Abschluss >--
' Query for errors
If Err.Number <> 0 Then
' MsgBox "Error: " & Err.Description
pErrorMessage = pErrorMessage & "<p></p> Fehler: " & Err.Description & " <o:p>" ' für html Textnachricht, die später an Email body angehängt wird
' Clear the error
Err.Clear
End If
' Disconnect, clean up
mySession.Dispose
' Restore default error handling
On Error GoTo 0
'--</ Abschluss >--
'--------</ fl_Download_SFTP() >--------
Application.StatusBar = False
End Sub
|