[AccessD] Transferring Files via FTP

Jim Dettman jimdettman at verizon.net
Fri Oct 9 15:28:13 CDT 2020


David,

<< Do you have WinSCP examples for getting files from and putting files up
to a
SFTP site?>>

  They are below.   Some notes:

1. These are single file operations with a login/out for each file, which is
highly inefficient if you have a lot of files to transfer.   These were
specifically written this way due to the nature of the application.   Most
FTP clients have a MGET() / MPUT()  ('M' for many) command available.  Not
sure what WinSCP has available in that regard.
2. These routines were written over fifteen years ago.  The commands
available with WinSCP I'm sure have been changed/expanded.   This code
however does work today and is currently in production.
3. These routines do not employ any type of "guarding" (ensuring a file
operation is complete).   With FTP, there is no file locking available so
it's possible that a file might be worked with (i.e. moved)  before the
transfer is complete.  There are two ways to accomplish that:

    a. You create a "guard file" first, then delete it when done.   i.e.
myFile.grd is created, myFile.txt is transferred, and mfFile.grd is deleted.
    b.  You send the file with a modified extension, then rename it when the
send is complete.  i.e.   myFile.xfer    becomes myFile.txt when done.

    Of course both ends must honor whatever method you use.    Single file
transfers are typically not a problem, unless the files are large.   But you
will run into this problem if you use any type of MGET()/MPUT() type
process.    I avoided a lot of problems by taking a directory snapshot
first, then working with the files one by one, which is one reason why these
routines are written the way they are.

  4. Some FTP clients now have a sync command, which keeps a local and
remote directory in sync.   Might be of interest depending on what your
needs are.   I believe WinSCP has such a command now.
  5. There's stuff in here that you won't have that you'll need to strip out
(WaitWhileRunning (), sending of e-mails,  and the error handler).

Best of luck with the project,
Jim.



Function IsValidFTPWinSCP(strFTPLogfile As String) As Boolean

          ' Checks log file to see if last FTP operation OK.
          
          Const RoutineName = "IsValidFTPWinSCP"
          Const Version = "1.3"

          Dim intFileNum As Integer
          Dim lsLine As String

10        On Error GoTo IsValidFTPWinSCP_Error

20        IsValidFTPWinSCP = False

30        intFileNum = FreeFile
40        Open strFTPLogfile For Input As #intFileNum

50        Do While Not EOF(intFileNum) And IsValidFTPWinSCP = False
60            Line Input #intFileNum, lsLine
70            If InStr(lsLine, "result success=" & Chr$(34) & "true") > 0
Then IsValidFTPWinSCP = True
80        Loop

IsValidFTPWinSCP_Exit:
90        On Error Resume Next

100       Close #intFileNum

110       Exit Function

IsValidFTPWinSCP_Error:
120       UnexpectedError ModuleName, RoutineName, Version, Err.Number,
Err.Description, Err.Source, VBA.Erl
130       Resume IsValidFTPWinSCP_Exit

End Function

Function FTPUploadFileWinSCP(strLocalFileName As String, strFTPFilename As
String, strFTPSiteName As String, strUserName As String, strPassword As
String, strFTPSiteFingerprint As String, Optional strTransferType As String)
As Boolean

          ' Procedure to upload file to FTP site.
          ' Uses WinSCP Client to upload File, which allows a SFTP transfer.
          ' Sends e-mail to ITALERT if upload fails and returns false.

          ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write.
          ' 2.2.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM
          '                                Changed logging to XML format.
          
          Const RoutineName = "FTPUploadFileWinSCP"
          Const Version = "2.2.1.0"

          Dim strFTPScriptFile As String
          Dim strFTPCommandFile As String
          Dim strFTPLogfile As String

          Dim lngHWnd As Long
          Dim intFileNum As Integer
          Dim strMailMessage As String

          Dim oOCS_SendMail As New OCS_SendMail

10        On Error GoTo FTPUploadFileWinSCP_Error

          ' Generate file names
20        strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName &
".txt"
30        strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName &
".bat"
40        strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName &
".xml"

          ' Write script file
50        intFileNum = FreeFile
60        Open strFTPScriptFile For Output As #intFileNum
70        Print #intFileNum, "option batch on"
80        Print #intFileNum, "option confirm off"

90        Print #intFileNum, "open sftp://" & strUserName & ":" &
strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) &
strFTPSiteFingerprint & Chr$(34)
100       Print #intFileNum, "option transfer " & IIf(strTransferType = "B",
"binary", "ascii")
110       Print #intFileNum, "put " & Chr$(34) & strLocalFileName & Chr$(34)
& " " & Chr$(34) & strFTPFilename & Chr$(34)
120       Print #intFileNum, "Close"

130       Print #intFileNum, "Exit"
140       Close #intFileNum

          ' Write command file
150       intFileNum = FreeFile

160       Open strFTPCommandFile For Output As #intFileNum
170       Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console
/script=" & strFTPScriptFile & " /log=" & strFTPLogfile
180       Close #intFileNum

          ' Execute
190       lngHWnd = Shell(strFTPCommandFile, vbHide)
200       WaitWhileRunning (lngHWnd)

          ' Check log file
210       If IsValidFTPWinSCP(strFTPLogfile) Then
220           FTPUploadFileWinSCP = True
230       Else
240           If DebugMode() = True Then
250               Stop
260               FTPUploadFileWinSCP = False
270           Else
280               oOCS_SendMail.SetParams "ITALERT", ".", "."
290               oOCS_SendMail.Subject = "WinSCP FTP Upload failed."
300               strMailMessage = "The file: " & strLocalFileName & " did
not upload." & vbCrLf
310               strMailMessage = strMailMessage & "Command, script, and
log files are attached." & vbCrLf & vbCrLf
320               strMailMessage = strMailMessage & "App name:" &
AppShortName() & " Version: " & AppVersion()
330               oOCS_SendMail.Message = strMailMessage
340               oOCS_SendMail.Attachment = strFTPCommandFile & ";" &
strFTPScriptFile & ";" & strFTPLogfile
350               oOCS_SendMail.Send
360               FTPUploadFileWinSCP = False
370           End If
380       End If

FTPUploadFileWinSCP_Exit:
390       On Error Resume Next

400       If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile
410       If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile
420       If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile

430       Close #intFileNum

440       Exit Function

FTPUploadFileWinSCP_Error:
450       UnexpectedError ModuleName, RoutineName, Version, Err.Number,
Err.Description, Err.Source, VBA.Erl
460       FTPUploadFileWinSCP = False
470       Resume FTPUploadFileWinSCP_Exit

End Function

Function FTPDownloadFileWinSCP(strLocalFileName As String, strFTPFilename As
String, strFTPSiteName As String, strUserName As String, strPassword As
String, strFTPSiteFingerprint As String, Optional strTransferType As String)
As Boolean

          ' Procedure to download a file from a FTP site.
          ' Sends e-mail to ITALERT if download fails and returns false.

          ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write.
          ' 1.0.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM
          ' 1.1.0.0 - 09/27/18 - OCS/JRD - Changed logging to XML format.

          Const RoutineName = "FTPDownloadFileWinSCP"
          Const Version = "1.0.1.0"

          Dim strFTPScriptFile As String
          Dim strFTPCommandFile As String
          Dim strFTPLogfile As String

          Dim lngHWnd As Long
          Dim intFileNum As Integer
          Dim strMailMessage As String
          Dim oOCS_SendMail As New OCS_SendMail

10        On Error GoTo FTPDownloadFileWinSCP_Error

          ' Generate file names
20        strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName &
".txt"
30        strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName &
".bat"
40        strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName &
".xml"

          ' Write script file
50        intFileNum = FreeFile
60        Open strFTPScriptFile For Output As #intFileNum
70        Print #intFileNum, "option batch on"
80        Print #intFileNum, "option confirm off"

90        Print #intFileNum, "open sftp://" & strUserName & ":" &
strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) &
strFTPSiteFingerprint & Chr$(34)
100       Print #intFileNum, "option transfer " & IIf(strTransferType = "B",
"binary", "ascii")
110       Print #intFileNum, "Get " & Chr$(34) & strFTPFilename & Chr$(34) &
" " & Chr$(34) & strLocalFileName & Chr$(34)
120       Print #intFileNum, "Close"
130       Print #intFileNum, "Exit"

140       Close #intFileNum

          ' Write command file
150       intFileNum = FreeFile

160       Open strFTPCommandFile For Output As #intFileNum
170       Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console
/script=" & strFTPScriptFile & " /Log=" & strFTPLogfile
180       Close #intFileNum

          ' Execute
190       lngHWnd = Shell(strFTPCommandFile, vbHide)
200       WaitWhileRunning (lngHWnd)


          ' Check log file
210       If IsValidFTPWinSCP(strFTPLogfile) Then
220           FTPDownloadFileWinSCP = True
230       Else
240           If DebugMode() = True Then
250               Stop
260               FTPDownloadFileWinSCP = False
270           Else
280               oOCS_SendMail.SetParams "ITALERT", ".", "."
290               oOCS_SendMail.Subject = "FTP download failed"
300               strMailMessage = "The file: " & strFTPFilename & " did not
download." & vbCrLf
310               strMailMessage = strMailMessage & "Command, script, and
log files are attached." & vbCrLf & vbCrLf
320               strMailMessage = strMailMessage & "App name:" &
AppShortName() & " Version: " & AppVersion()
330               oOCS_SendMail.Message = strMailMessage
340               oOCS_SendMail.Attachment = strFTPCommandFile & ";" &
strFTPScriptFile & ";" & strFTPLogfile
350               oOCS_SendMail.Send
360               FTPDownloadFileWinSCP = False
370           End If
380       End If

FTPDownloadFileWinSCP_Exit:
390       On Error Resume Next

400       If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile
410       If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile
420       If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile

430       Close #intFileNum

440       Exit Function

FTPDownloadFileWinSCP_Error:
450       UnexpectedError ModuleName, RoutineName, Version, Err.Number,
Err.Description, Err.Source, VBA.Erl
460       FTPDownloadFileWinSCP = False
470       Resume FTPDownloadFileWinSCP_Exit

End Function

Function FTPDeleteFileWinSCP(strFTPFilename As String, strFTPSiteName As
String, strUserName As String, strPassword As String, strFTPSiteFingerprint
As String) As Boolean

          ' Procedure to delete file on FTP site.
          ' Sends e-mail to ITALERT if upload fails and returns false.

          ' 1.0.0.0 - ??/??/?? - OCS/JRD - Initial write.
          ' 1.0.1.0 - 09/26/18 - OCS/JRD - Removed pathing on WinSCP.COM
          ' 1.1.0.0 - 09/27/18 - OCS/JRD - Changed logging to XML format.

          Const RoutineName = "FTPDeleteFileWinSCP"
          Const Version = "1.0.1.0"

          Dim strFTPCommandFile As String
          Dim strFTPScriptFile As String
          Dim strFTPLogfile As String

          Dim lngHWnd As Long
          Dim intFileNum As Integer
          Dim strMailMessage As String
          Dim oOCS_SendMail As New OCS_SendMail

10        On Error GoTo FTPDeleteFileWinSCP_Error

          ' Generate file names
20        strFTPScriptFile = "\FTP_" & AppShortName() & "_" & RoutineName &
".txt"
30        strFTPCommandFile = "\FTP_" & AppShortName() & "_" & RoutineName &
".bat"
40        strFTPLogfile = "\FTP_" & AppShortName() & "_" & RoutineName &
".xml"

          ' Write script file
50        intFileNum = FreeFile
60        Open strFTPScriptFile For Output As #intFileNum
70        Print #intFileNum, "option batch on"
80        Print #intFileNum, "option confirm off"

90        Print #intFileNum, "open sftp://" & strUserName & ":" &
strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) &
strFTPSiteFingerprint & Chr$(34)
100       Print #intFileNum, "rm " & Chr$(34) & strFTPFilename & Chr$(34)
110       Print #intFileNum, "Close"

120       Print #intFileNum, "Exit"
130       Close #intFileNum

          ' Write command file
140       intFileNum = FreeFile

150       Open strFTPCommandFile For Output As #intFileNum
160       Print #intFileNum, Chr$(34) & "winscp.com" & Chr$(34) & "/console
/script=" & strFTPScriptFile & " /Log=" & strFTPLogfile
170       Close #intFileNum

          ' Execute
180       lngHWnd = Shell(strFTPCommandFile, vbHide)
190       WaitWhileRunning (lngHWnd)

          ' Check log file
200       If IsValidFTPWinSCP(strFTPLogfile) Then
210           FTPDeleteFileWinSCP = True
220       Else
230           If DebugMode() = True Then
240               Stop
250               FTPDeleteFileWinSCP = False
260           Else
270               oOCS_SendMail.SetParams "ITALERT", ".", "."
280               oOCS_SendMail.Subject = "FTP Delete failed"
290               strMailMessage = "The file: " & strFTPFilename & " did not
delete from the FTP site." & vbCrLf
300               strMailMessage = strMailMessage & "Command, script, and
Log files are attached." & vbCrLf & vbCrLf
310               strMailMessage = strMailMessage & "App name:" &
AppShortName() & " Version: " & AppVersion()
320               oOCS_SendMail.Message = strMailMessage
330               oOCS_SendMail.Attachment = strFTPCommandFile & ";" &
strFTPScriptFile & ";" & strFTPLogfile
340               oOCS_SendMail.Send
350               FTPDeleteFileWinSCP = False
360           End If
370       End If

FTPDeleteFileWinSCP_Exit:
380       On Error Resume Next

390       If Dir(strFTPCommandFile) <> "" Then Kill strFTPCommandFile
400       If Dir(strFTPScriptFile) <> "" Then Kill strFTPScriptFile
410       If Dir(strFTPLogfile) <> "" Then Kill strFTPLogfile

420       Close #intFileNum

430       Exit Function

FTPDeleteFileWinSCP_Error:
440       UnexpectedError ModuleName, RoutineName, Version, Err.Number,
Err.Description, Err.Source, VBA.Erl
450       Resume FTPDeleteFileWinSCP_Exit

End Function



More information about the AccessD mailing list