[AccessD] Transferring Files via FTP
David Emerson
newsgrps at dalyn.co.nz
Fri Oct 9 15:49:43 CDT 2020
Thanks Jim, That will get me a long way along the track.
-----Original Message-----
From: AccessD <accessd-bounces at databaseadvisors.com> On Behalf Of Jim
Dettman via AccessD
Sent: Saturday, 10 October 2020 9:28 am
To: AccessD List <AccessD at databaseadvisors.com>
Cc: Jim Dettman <jimdettman at verizon.net>
Subject: Re: [AccessD] Transferring Files via FTP
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
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com
More information about the AccessD
mailing list