[AccessD] Transferring Files via FTP

Stuart McLachlan stuart at lexacorp.com.pg
Fri Oct 9 04:32:01 CDT 2020


It's not returning any files because FTP.exe uses plain text FTP protocol  over port 21

SFTP uses a secure (SSH) connection over Port 22.


On 9 Oct 2020 at 22:15, David Emerson wrote:

> So I should ignore the ping test and work on why the ListFTPFiles
> function is not returning any files?
> 
> -----Original Message-----
> From: AccessD <accessd-bounces at databaseadvisors.com> On Behalf Of
> Stuart McLachlan Sent: Friday, 9 October 2020 10:09 pm To: Access
> Developers discussion and problem solving
> <accessd at databaseadvisors.com> Subject: Re: [AccessD] Transferring
> Files via FTP
> 
> They are blocking PINGs so  a PING test won't work for that site.
> 
> However I was able to connect to that host using SFTP through  WInSCP.
> on Port 22
> 
> On 9 Oct 2020 at 21:08, David Emerson wrote:
> 
> > Spoke too soon.  Now the Ping message is:
> > 
> > Pinging 143.96.3.34 with 32 bytes of data:
> > Request timed out.
> > 
> > Ping statistics for 143.96.3.34:
> >     Packets: Sent = 1, Received = 0, Lost = 1 (100% loss),
> > 
> > I have increased the wait time to 60 seconds but still with the same
> > result.
> > 
> > 
> > Here is the ping command:
> > C:\Windows\system32\cmd.exe /c ping 143.96.3.34 -n 1 -w 60000 >
> > "C:\aaTemp\pingtest.txt"
> > 
> > However, I cannot connect with FileZilla using the IP Address.  It
> > only seems to work with sftp://sftp.electricityregistry.co.nz (and
> > connects within a couple of seconds).
> > 
> > In summary,
> > Pinging the server name gets: Ping request could not find host
> > sftp://sftp.electricityregistry.co.nz. Pinging the server IP gets:
> > Request timed out. Connecting via FileZilla using the server name
> > (and login) works.
> > 
> > What is my code missing?
> > 
> > Regards
> > 
> > David Emerson
> > Dalyn Software Ltd
> > Wellington, New Zealand
> > 
> > 
> > 
> > -----Original Message-----
> > From: AccessD <accessd-bounces at databaseadvisors.com> On Behalf Of
> > David Emerson Sent: Friday, 9 October 2020 8:34 pm To: 'Access
> > Developers discussion and problem solving'
> > <accessd at databaseadvisors.com> Subject: Re: [AccessD] Transferring
> > Files via FTP
> > 
> > Hi Stuart (and others),
> > 
> > I am working on your code below.  I am initially checking that I can
> > ping to the server using the InternetOK() function but I am getting
> > an error: Ping request could not find host
> > sftp://sftp.electricityregistry.co.nz. Please check the name and try
> > again.
> > 
> > Here is my modified Code (without error coding):
> > 
> > Function InternetOK() As Boolean
> > 
> >     Dim strTemp As String, strExe As String, ff As Long
> > 
> >     strExe = Environ$("COMSPEC")
> >     strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe)))
> > 
> >     strExe = Environ("COMSPEC") & " /c "
> >     strExe = strExe & "ping sftp://sftp.electricityregistry.co.nz -n
> >     1
> >     > """
> > & TempDir() & "pingtest.txt"""
> >     ShellWait strExe, vbHide
> > 
> >     Debug.Print strExe
> >     ff = FreeFile
> >     Open TempDir() & "pingtest.txt" For Input As #ff
> >     Line Input #ff, strTemp
> >     Close #ff
> >     If InStr(strTemp, "Ping request could not find host") > 0 Then
> >         InternetOK = False
> >     Else
> >         InternetOK = True
> >     End If
> > 
> > End Function
> > 
> > I am able to connect using FileZilla.  But this includes a login and
> > password.
> > 
> > Can anyone suggest what I am doing wrong?
> > 
> > Regards
> > 
> > David Emerson
> > Dalyn Software Ltd
> > Wellington, New Zealand
> > 
> > 
> > 
> > -----Original Message-----
> > From: AccessD <accessd-bounces at databaseadvisors.com> On Behalf Of
> > Stuart McLachlan Sent: Wednesday, 6 May 2020 11:42 am To: Access
> > Developers discussion and problem solving
> > <accessd at databaseadvisors.com> Subject: Re: [AccessD] Transferring
> > Files via FTP
> > 
> > Heres' a  modFTP from an old application of mine which uses the
> > built in Windows FTP client and an FTP script generated "on the
> > fly".  It will need PTRSAFE, LONGPTR etc modifications for Officer
> > 64bit.
> > 
> > (These days, I  SHELL to my own applicationa written in PowerBASIC
> > for all FPT processes)
> > 
> > 
> > Option Explicit
> > Option Compare Database
> > 
> > Private Const STARTF_USESHOWWINDOW& = &H1 Private Const 
> > NORMAL_PRIORITY_CLASS = &H20& Private Const INFINITE = -1&
> > 
> > Public g_strFTPPutList() As String
> > 
> > Private Type STARTUPINFO
> >     cb As Long
> >     lpReserved As String
> >     lpDesktop As String
> >     lpTitle As String
> >     dwX As Long
> >     dwY As Long
> >     dwXSize As Long
> >     dwYSize As Long
> >     dwXCountChars As Long
> >     dwYCountChars As Long
> >     dwFillAttribute As Long
> >     dwFlags As Long
> >     wShowWindow As Integer
> >     cbReserved2 As Integer
> >     lpReserved2 As Long
> >     hStdInput As Long
> >     hStdOutput As Long
> >     hStdError As Long
> > End Type
> > 
> > Private Type PROCESS_INFORMATION
> >     hProcess As Long
> >     hThread As Long
> >     dwProcessID As Long
> >     dwThreadID As Long
> > End Type
> > 
> > Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle
> > As Long, ByVal dwMilliseconds As Long) As Long
> > 
> > Declare Function CreateProcessA Lib "kernel32" (ByVal 
> > lpApplicationName As Long, ByVal lpCommandLine As String, ByVal
> > lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal
> > bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal
> > lpEnvironment As Long, ByVal lpCurrentDirectory As Long,
> > lpStartupInfo As STARTUPINFO, lpProcessInformation As
> > PROCESS_INFORMATION) As Long
> > 
> > Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long)
> > As Long
> > 
> > Public Sub ShellWait(Pathname As String, Optional WindowStyle As
> > Long) On Error GoTo Err_Handler
> > 
> >    Dim proc As PROCESS_INFORMATION
> >    Dim start As STARTUPINFO
> >    Dim ret As Long
> > 
> >    ' Initialize the STARTUPINFO structure:
> >    With start
> >       .cb = Len(start)
> >       If Not IsMissing(WindowStyle) Then
> >          .dwFlags = STARTF_USESHOWWINDOW
> >          .wShowWindow = WindowStyle
> >       End If
> >    End With
> >    ' Start the shelled application:
> >    ret& = CreateProcessA(0&, Pathname, 0&, 0&, 1&,
> >    NORMAL_PRIORITY_CLASS,
> > 0&, 0&, start, proc)
> >    ' Wait for the shelled application to finish:
> >    ret& = WaitForSingleObject(proc.hProcess, INFINITE)
> >    ret& = CloseHandle(proc.hProcess)
> > 
> > Exit_Here:
> >    Exit Sub
> > Err_Handler:
> >    MsgBox Err.Description, vbExclamation, "E R R O R"
> >    Resume Exit_Here
> > 
> > End Sub
> > 
> > 
> > 'Following functions look for Site, Login, PW in table usysWeb
> > Function ListFTPFiles(Directory As String) As Variant Const q As
> > String * 1 = """" Dim sEXE As String Dim strList As String Dim
> > strFIles() As String Dim x As Long Dim ff As Long strList =
> > TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As
> > #ff Print 
> > #ff, "open " & DLookup("Site", "usysWEB") Print #ff,
> > #DLookup("Login",
> > "usysWEB") Print #ff, DLookup("PW", "usysWEB") Print #ff, "cd " &
> > Directory Print #ff, "ls . " & TempDir() & "\" & "webfiles.txt"
> > Print 
> > #ff, "bye" Close #ff sEXE = Environ$("COMSPEC") sEXE = Left$(sEXE,
> > Len(sEXE) - Len(Dir(sEXE))) sEXE = sEXE & "ftp.exe -s:" & q &
> > strList & q ShellWait sEXE, vbHide Kill strList ff = FreeFile Open
> > TempDir() & "webfiles.txt" For Input As #ff While Not EOF(ff)
> >    x = x + 1
> >    ReDim Preserve strFIles(x)
> >    Line Input #1, strFIles(x)
> > Wend
> > Close #ff
> > 'Kill TempDir() & "webfiles.txt"
> > ListFTPFiles = strFIles()
> > End Function
> > 
> > Function FTPPut(Directory As String, Filename As String) As Boolean
> > Const q As String * 1 = """" Dim strExe As String Dim strLocalDir As
> > String Dim strFName As String Dim strList As String Dim ff As Long
> > If Dir(Filename) = "" Then
> >    MsgBox Filename & " not found!"
> >    Exit Function
> > End If
> > strLocalDir = Left$(Filename, InStrRev(Filename, "\") - 1) If
> > Len(strLocalDir) = 2 Then strLocalDir = strLocalDir & "\"
> > strFName = Mid$(Filename, InStrRev(Filename, "\") + 1) strList =
> > TempDir() & "FTPCmds.tmp" ff = FreeFile Open strList For Output As
> > #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print #ff,
> > DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB")
> > Print 
> > #ff, "cd " & Directory Print #ff, "lcd " & q & strLocalDir & q Print
> > # ff, "binary" Print #ff, "put " & q & strFName & q Print #ff, "bye"
> > Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe,
> > Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q
> > & strList & q ShellWait strExe, vbHide 'vbNormalFocus 'Kill strList
> > End Function
> > 
> > Function FTPGet(Filename As String, LocalDirectory As String) As
> > Boolean Const q As String * 1 = """" Dim strExe As String Dim
> > strFTPDir As String Dim strFName As String Dim strList As String Dim
> > ff As Long If Dir(LocalDirectory, vbDirectory) = "" Then
> >    MsgBox LocalDirectory & " not found"
> >    Exit Function
> > End If
> > strFTPDir = Left$(Filename, InStrRev(Filename, "/")) strFName =
> > Mid$(Filename, InStrRev(Filename, "/") + 1) strList = TempDir() &
> > "FTPCmds.tmp" ff = FreeFile Open strList For Output As #ff Print
> > #ff, "open " & DLookup("Site", "usysWEB") Print #ff,
> > DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB")
> > Print #ff, "cd " & strFTPDir Print #ff, "lcd " & LocalDirectory
> > Print #ff, "binary" Print 
> > #ff, "get " & q & strFName & q Print #ff, "bye" Close #ff strExe =
> > Environ$("COMSPEC") strExe = Left$(strExe, Len(strExe) -
> > Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q & strList & q
> > ShellWait strExe, vbHide Kill strList End Function
> > 
> > Function InternetOK() As Boolean
> > Dim strTemp As String
> > Dim strExe As String
> > Dim ff As Long
> > strExe = Environ$("COMSPEC")
> > strExe = Left$(strExe, Len(strExe) - Len(Dir(strExe)))
> > 
> > strExe = Environ("COMSPEC") & " /c "
> > strExe = strExe & "ping " & DLookup("Site", "usysWEB") & " -n 1 >
> > """ & TempDir() & "pingtest.txt""" ShellWait strExe, vbHide
> > 'Debug.Print strExe ff = FreeFile Open TempDir() & "pingtest.txt"
> > For Input As #ff Line Input #ff, strTemp Close #ff If InStr(strTemp,
> > "Ping request could not find host") > 0 Then
> >    InternetOK = False
> > Else
> >    InternetOK = True
> > End If
> > 
> > End Function
> > 
> > Function FTPPutList(FileList() As String) As Boolean 'FileList Array
> > is 0 based Row(0) is blank. ' Subsequent rows formatted as:
> > RemoteDir[Tab]LocalDir[Tab]Filename[Tab] Const q As String * 1 =
> > """" Dim strExe As String Dim strLocalDir As String Dim strRemoteDir
> > As String Dim strLocalDirStore As String Dim strRemoteDirStore As
> > String Dim strFileName As String Dim strList As String Dim strCmds
> > As String Dim ff As Long Dim x As Long Dim strPut() As String
> > strCmds = TempDir() & "FTPCmds.tmp" ff = FreeFile Open strCmds For
> > Output As #ff Print #ff, "open " & DLookup("Site", "usysWEB") Print
> > #ff, DLookup("Login", "usysWEB") Print #ff, DLookup("PW", "usysWEB")
> > Print 
> > #ff, "binary"
> > 
> > For x = 1 To UBound(FileList())
> >     strPut() = Split(FileList(x), Chr$(9))
> >     strRemoteDir = strPut(0)
> >     strLocalDir = strPut(1)
> >     strFileName = strPut(2)
> > 
> >     If strRemoteDir <> strRemoteDirStore Then
> >        Print #ff, "cd " & strRemoteDir
> >        strRemoteDirStore = strRemoteDir
> >     End If
> > 
> >     If strLocalDir <> strLocalDirStore Then
> >        Print #ff, "lcd " & strLocalDir
> >        strLocalDirStore = strLocalDir
> >     End If
> > 
> >     If Dir(strLocalDir & strFileName) = "" Then
> >        MsgBox strLocalDir & strFileName & " not found!"
> >        Exit Function
> >     End If
> > 
> >     Print #ff, "put " & q & strFileName & q Next Print #ff, "bye"
> > Close #ff strExe = Environ$("COMSPEC") strExe = Left$(strExe,
> > Len(strExe) - Len(Dir(strExe))) strExe = strExe & "ftp.exe -s:" & q
> > & strList & q ShellWait strExe, vbHide 'vbNormalFocus End Function
> > ---------------------- END OF modFTP
> > 
> > modFTP also uses this
> > 
> > Private Declare Function GetTempPath Lib "kernel32" Alias 
> > "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As
> > String) As Long
> > 
> > Public Function TempDir() As String
> > Dim strPath As String
> >  strPath = Space(MAX_PATH)
> >  GetTempPath Len(strPath), strPath
> >   TempDir = Left(strPath, InStr(1, strPath, vbNullChar) - 1) End
> >   Function
> > 
> > 
> > 
> > On 6 May 2020 at 11:07, David Emerson wrote:
> > 
> > > Hi Listers,
> > > 
> > > 
> > > 
> > > I hope everyone is keeping safe.
> > > 
> > > 
> > > 
> > > Can anyone give me recommendations for code/software so that I can
> > > log into a secure FTP site using a username and password, and
> > > upload and download files via vba?
> > > 
> > > 
> > > 
> > > Regards
> > > 
> > > David Emerson
> > > Dalyn Software Ltd
> > > Wellington, New Zealand
> > 
> > --
> > AccessD mailing list
> > AccessD at databaseadvisors.com
> > http://databaseadvisors.com/mailman/listinfo/accessd
> > Website: http://www.databaseadvisors.com
> > 
> > --
> > AccessD mailing list
> > AccessD at databaseadvisors.com
> > http://databaseadvisors.com/mailman/listinfo/accessd
> > Website: http://www.databaseadvisors.com
> > 
> 
> 
> -- 
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
> 
> -- 
> 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