[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