[AccessD] Transferring Files via FTP

Stuart McLachlan stuart at lexacorp.com.pg
Fri Oct 9 02:55:57 CDT 2020


Yep, you should not have put the protocol in front of the host name

PING sftp.electricityregistry.co.nz
not
PING sftp://sftp.electricityregistry.co.nz

On 9 Oct 2020 at 20:43, David Emerson wrote:

> Solved that one by using the IP address instead of the server name.
> 
> -----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
> 




More information about the AccessD mailing list