[AccessD] Transferring Files via FTP

[Jim Dettman]

Few things to add:

1. I've used WinSCP for SFTP, MoveItFreely for FTPs, along with the
Microsoft FTP client to cover all the bases.   I've pasted in an example of
using WinSCP to get a directory listing below.

2. Rather than a ping, which is often blocked by firewalls, you can use
TELNET <port number> to test manually if a server is reachable.   It also
allows you to type commands manually one by one to confirm where scripts
might be going wrong.

3. When doing the scripts, always put them in a batch file, then call the
batch file.   This allows you to execute the bat file manually outside of
your code.    Normally what I do is TELNET first, figuring out the commands
I need, then build a batch file and test that, then build the batch file in
code and test that.

HTH,
Jim.

Function FTPDirListWinSCP(strFiles As String, strFTPDir As String,
strFTPSiteName As String, strUserName As String, strPassword As String,
strFTPSiteFingerprint As String) As Boolean

          ' Returns list of files in a remote directory.

          ' Note that with the WinSCP client, the only way to capture the
          ' files in a directory is with the /LOG option in the command line
using an XML format for it.
          '
          ' Normally with most clients, writing the output to a file is an
option
          ' of the Dir or ls commands.  WinSCP doesn't have this option.
          '
          ' The log file is the regular redirect of the command line output
as with the other clients.

          Const RoutineName = "FTPDirListWinSCP"
          Const Version = "2.2.1"

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

          Dim strFileName As String
          Dim strDestName As String

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

10        On Error GoTo FTPDirListWinSCP_Error

20        FTPDirListWinSCP = False

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

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

100       Print #intFileNum, "open sftp://" & strUserName & ":" &
strPassword & "@" & strFTPSiteName & " -hostkey=" & Chr$(34) &
strFTPSiteFingerprint & Chr$(34)
110       Print #intFileNum, "ls " & Chr$(34) & strFTPDir & 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" & Chr$(34) & "/console
/script=" & strFTPScriptFile & " /log=" & Chr$(34) & strFTPLogfile &
Chr$(34)
180       Close #intFileNum

          ' Execute
190       lngHWnd = Shell(strFTPCommandFile, vbHide)
200       WaitWhileRunning (lngHWnd)
'Stop
          ' Check log file (file is returned whether the directory query was
good or bad,
          ' so the command log needs to be checked).
210       If IsValidFTPWinSCPDirectoryCall(strFTPLogfile, strFiles) = True
Then
220           FTPDirListWinSCP = True
230       Else
240           If DebugMode() = True Then
250               Stop
260           Else
270               oOCS_SendMail.SetParams "ITALERT", ".", "."
280               oOCS_SendMail.Subject = "FTP Directory query failed"
290               strMailMessage = "Unable to query directory " & strFTPDir
& " on 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           End If
360       End If


FTPDirListWinSCP_Exit:
370       On Error Resume Next

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

410       Close #intFileNum

420       Set oOCS_SendMail = Nothing

430       Exit Function

FTPDirListWinSCP_Error:
440       UnexpectedError ModuleName, RoutineName, Version, Err.Number,
Err.Description, Err.Source, VBA.Erl
450       FTPDirListWinSCP = False
460       Resume FTPDirListWinSCP_Exit

End Function

Function IsValidFTPWinSCPDirectoryCall(strFTPLogfile As String, strFiles As
String) As Boolean

          ' Checks log file to see if last FTP directory/file operation was
OK.
          ' This is used to check for directory listings.
          ' Files are picked up in the process of determining if the call
was valid or not.
          ' The command log shows 'result sccess="true" if valid.
          ' Log file is in XML format

          Const RoutineName = "IsValidFTPWinSCPDirectoryCall"
          Const Version = "1.0.0.0"

          Dim intFileNum As Integer
          Dim lsLine As String
          Dim strFileName As String

10        On Error GoTo IsValidFTPWinSCPDirectoryCall_Error

20        IsValidFTPWinSCPDirectoryCall = False

30        strFiles = ""
          
40        intFileNum = FreeFile
50        Open strFTPLogfile For Input As #intFileNum

60        Do While Not EOF(intFileNum) And IsValidFTPWinSCPDirectoryCall =
False
70            Line Input #intFileNum, lsLine

              ' See if a file is referenced
80            If InStr(1, lsLine, "<filename value=") > 0 Then
90                strFileName = Mid$(lsLine, InStr(1, lsLine, "<filename
value=") + 17)
If left$(strFileName, 2) <> ".." Then
100               strFiles = strFiles & Mid$(strFileName, 1, InStr(1,
strFileName, Chr$(34)) - 1) & ";"
End If
110           End If

              ' or if this is the end.
120           If InStr(lsLine, "result success=" & Chr$(34) & "true") > 0
Then IsValidFTPWinSCPDirectoryCall = True
130       Loop

IsValidFTPWinSCPDirectoryCall_Exit:
140       On Error Resume Next

150       Close #intFileNum

160       Exit Function

IsValidFTPWinSCPDirectoryCall_Error:
170       UnexpectedError ModuleName, RoutineName, Version, Err.Number,
Err.Description, Err.Source, VBA.Erl
180       IsValidFTPWinSCPDirectoryCall = False
190       Resume IsValidFTPWinSCPDirectoryCall_Exit

End Function